VBA for Auto Filter and Copy/Past the Visible Cells at Destination Workbook

[mdasifiqbal]

Dear Friends

I'm in need for help with a VBA which I'm trying to create but failed miserably as i'm still a novice. I was trying to make a VBA for Auto Filtering the Master Workbook by Customers name appearing in Column A (A7) and Copy/Paste the Visible Cells in Sheet1 of Workbook in the name of customer after clearing all data and template, same action need to be performed for all the customers in the Master workbook. so that when I run the programme all the customers workbook get updated automatically.

Thanks & Regards

Md Asif Iqbal

[mdmackillop]

Copy/Paste the Visible Cells in Sheet1 of Workbook in the name of customer after clearing all data and template, same action need to be performed for all the customers in the Master workbook

Please confirm; you want to create a unique list of customers in sheet 1 of a different workbook

. so that when I run the programme all the customers workbook get updated automatically.

Please confirm; When you run the code the previous list created above will be deleted and replaced by the current data

[mdasifiqbal]

Dear Mdmackillop

The master workbook which I had attached will be containing all the customers, and the data from master workbook for each unique customer need to be copy/paste to the workseet1 of each individual customer, for example if I have data for 1000 transaction of 10 customers (Ex Customer Name A,B,C,D,E,F,G,H,I,J) in master workbook appearing as 1000 line items which will be filtered and copy/paste to worksheet 1 of Workbook Named A,B,C,D,E,F,G,H,I,J. hope I'm clear

Thanks and Regards

[mdasifiqbal]

Yes I want the pervious data to be deleted once updated

[mdmackillop]

Give this a try

Option Explicit 
Sub ConsolidateData()
     
    Dim WB As Workbook
    Dim wbTgt As Workbook
    Dim Source As Range, cel As Range, tgt As Range
    Dim Dic As Object, d
    Dim Pth As String, f As String
    Dim x
    
    Application.ScreenUpdating = False
    Set Dic = CreateObject("Scripting.Dictionary")
    Set WB = ThisWorkbook
    Pth = ThisWorkbook.Path & "\"
    
    'Create unique list
    With Sheet1
        Set Source = Range(.Cells(7, 1), .Cells(Rows.Count, 1).End(xlUp))
        On Error Resume Next
        For Each cel In Source.Offset(1).Cells
            x = CStr(cel.Value)
            If x <> "" Then Dic.Add x, x
        Next cel
        On Error GoTo 0
        'Create workbooks that don't exist
        For Each d In Dic.keys
            If Len(Dir(Pth & d & ".xlsx")) Then
                'do nothing
            Else
                Workbooks.Add
                ActiveWorkbook.SaveAs Pth & d & ".xlsx"
                ActiveWorkbook.Close False
            End If
        Next d
        'Set filtersource, open workbooks, clear target and copy data
        Set Source = Range(.Cells(6, 1), .Cells(Rows.Count, 1).End(xlUp))
        For Each d In Dic.keys
            Set wbTgt = Workbooks.Open(Pth & d & ".xlsx")
            Set tgt = ActiveWorkbook.Sheets("Sheet1").Cells(1, 1)
            tgt.CurrentRegion.ClearContents
            Source.AutoFilter 1, d
            Source.Offset(-5).Resize(Source.Rows.Count + 6, 12).SpecialCells(xlCellTypeVisible).Copy
            tgt.PasteSpecial xlPasteValues
            tgt.PasteSpecial xlFormats
            wbTgt.Close True
            Source.AutoFilter
        Next d
    End With
    Application.ScreenUpdating = True
End Sub

[mdasifiqbal]

Dear Mdmacillop

This is quite close to what I want, but if the code is tweaked a little to copy the data from A1 to the next line upto which the data is filtered, suppose the code filters the customers and the data appears in five line item, the copy/paste to the unique customer workbook should be from A1 to the next line of filtered data and the same get pasted in the respective workbook of the customer

Regards
Md Asif Iqbal

[mdasifiqbal]

one more thing the code does not stop when the last customer is reached.

[mdmackillop]

I've amended the code posted above to include Row 1 and also to PasteSpecial values. I don't know what you mean by Post #7

[mdasifiqbal]

the code doesn't stop after copy/past is performed on last customer in the list, it again starts from the 1st customer and so on

[mdmackillop]

I can't replicate that behavior. Try stepping through that section of the code to isolate the issue.

[mdasifiqbal]

I tried but any modification to the above code is making it non functional, and is not giving any results even though its creating the new file but with no data in it

[mdmackillop]

Are you running this on your posted sample? If not can you post your workbook.

[mdasifiqbal]

Dear Mdmackillop

have attached the complete file

Regards

Asif

[mdmackillop]

Hi Asif
I've checked the code. It loops once to create the initial workbooks or add "missing" ones. It loops a second time to put the data into the workbooks. I cannot see the behavior you describe.

In the attached copy, I've added code which will open a file if you double-click the name in column A

[mdasifiqbal]

Thanks a lot its working the perfect way as I wanted, I'm really grateful to you.

Thanks & Regards
Md Asif Iqbal