Create new workbook and sort and copy data into new workbook using VBA

[Satyaprakash]

Hi All,

I have a small issue that need help with. Its pretty routine and can be done with VBA, but somehow I am stumped as to how.
I have a master sheet in which I have data in 6 sheets - Sheet 1, Con1, Con2, Con3, Sheet 2 and Sheet 3 . The Con data about various customers and their contracts. I need to sort by each customer, and copy their data from the Con sheets and paste it in a new workbook in sheets with the same name. Sheets 1,2 and 3 need to pasted as is. The new workbook should have its name as the customer's name.
For example, if I have 3 customers - A, B and C. I will first sort by A in the 3 con sheets. Then create a new workbook with name A. Copy the Sheets 1,2,3 as they are to workbook A. Copy the sorted data to workbook A into 3 sheets and rename them as Con1, Con2 and Con3.
A customers name will be repeated in the same sheet numerous times with different codes.
I need to take all the entries in the name of the same customer.
I have uploaded a reference file for perusal.
Request someone to help me out.
__________________________________________________________________

Mod edit : post moved to proper forum …​

 

[Marc L]

Hi !

Paste this demonstration to a code workbook (not Master) :​

Sub Demo()
        Dim oW As Workbook
If Evaluate("ISREF('[Master.xlsx]Con1'!A1)") Then
        Set oW = Workbooks("Master.xlsx")
            WB = oW.FullName
Else
            WB = "D:\Tests4Noobs\Master.xlsx"
    If Dir(WB) = "" Then Beep: Exit Sub
        Set oW = GetObject(WB)
End If
            Application.ScreenUpdating = False
With CreateObject("Scripting.Dictionary")
    For C& = 1 To 3
        VA = oW.Worksheets("Con" & C).UsedRange.Columns(2).Value
        For R& = 2 To UBound(VA):  .Item(VA(R, 1)) = "":  Next
    Next
            oW.Close Not oW.Saved
        Set oW = Nothing
    For R = 0 To .Count - 1
                            N$ = .Keys()(R)
                            F$ = Replace$(WB, "Master", N)
               FileCopy WB, F
        With Workbooks.Open(F)
            For C = 1 To 3
                With .Worksheets("Con" & C).UsedRange
                     .Columns(2).AutoFilter 1, "<>" & N
                     .Offset(1).Delete xlShiftUp
                     .AutoFilter
                End With
            Next
                .Close True
        End With
    Next
        .RemoveAll
End With
            Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Satyaprakash]

Thanks a lot mate!