VBA to copy data based on column data to multiple files

[LyonDer]

Hello,

I've looked up several posts on copying data from a report to multiple files based on the data in the first column. My original report uses rows 1 & 2 as the header so my data would start at A3. I want the header from rows 1 & 2 to copy to each new file with the filtered data. I've been unsuccessful in finding similar and my attempts to manipulate what I've found have been unsuccessful as well. Any help greatly appreciated.

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[LyonDer]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

Thanks. Here is a box link for my file : Data Split Workbook Example.xlsx | Powered by Box

I want to reference the data in column A (A2 and down). I want to create new workbooks for each unique/filtered data entry in column A copying the data on each row to the new workbook. Each new workbook should also have the header (Row 1). This example file goes from column A to M, but with application there could be more or fewer columns.

I'd like to create the Module in my personal.xlsb and save the procedure to an icon on a customized toolbar.

 

[mumps]

Change the workbook name (in red) to suit your needs. Please note that the worksheet name "Summary " in your file has a trailing space. Please delete that extra space.

Sub CreateWorkbooks()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, v As Variant, dic As Object, i As Long
    Set srcWS = Workbooks("Data Split Workbook Example.xlsx").Sheets("Summary")
    v = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v) To UBound(v)
        If Not dic.exists(v(i, 1)) Then
            dic.Add v(i, 1), Nothing
            With srcWS
                .Range("A1").CurrentRegion.AutoFilter 1, v(i, 1)
                Workbooks.Add
                .AutoFilter.Range.Copy Range("A1")
                .Columns.AutoFit
            End With
        End If
    Next i
    srcWS.Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[LyonDer]

Change the workbook name (in red) to suit your needs. Please note that the worksheet name "Summary " in your file has a trailing space. Please delete that extra space.

Sub CreateWorkbooks()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, v As Variant, dic As Object, i As Long
    Set srcWS = Workbooks("Data Split Workbook Example.xlsx").Sheets("Summary")
    v = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v) To UBound(v)
        If Not dic.exists(v(i, 1)) Then
            dic.Add v(i, 1), Nothing
            With srcWS
                .Range("A1").CurrentRegion.AutoFilter 1, v(i, 1)
                Workbooks.Add
                .AutoFilter.Range.Copy Range("A1")
                .Columns.AutoFit
            End With
        End If
    Next i
    srcWS.Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

This is great. Thank you! Since the Workbook could be under different names, is it possible to set the workbook to the current/active workbook instead of entering a static name? Also, I noticed data stops at column E even though there is additional data through column M. Is this because of blank filler columns. Can I have it copy all of the data as presented on the original workbook?

 

[mumps]

Try:

Sub CreateWorkbooks()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, v As Variant, dic As Object, i As Long
    Set srcWS = ActiveWorkbook.Sheets("Summary")
    v = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v) To UBound(v)
        If Not dic.exists(v(i, 1)) Then
            dic.Add v(i, 1), Nothing
            With srcWS
                .Range("A1", Range("M" & Rows.Count).End(xlUp)).AutoFilter 1, v(i, 1)
                Workbooks.Add
                .AutoFilter.Range.Copy Range("A1")
                .Columns.AutoFit
            End With
        End If
    Next i
    srcWS.Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[LyonDer]

.Range("A1", Range("M" & Rows.Count).End(xlUp)).AutoFilter 1, v(i, 1)

I'm receiving a run-time error '1004': method range of object worksheet failed. Any reason why that would occur?

 

[Alex Blakenburg]

Does it make any difference if you put a period "." before the 2nd use of Range eg

.Range("A1", .Range("M" & Rows.Count).End(xlUp)).AutoFilter 1, v(i, 1)

 

[mumps]

@Alex Blakenburg
Thanks for picking up on that.

 

[LyonDer]

Does it make any difference if you put a period "." before the 2nd use of Range eg

.Range("A1", .Range("M" & Rows.Count).End(xlUp)).AutoFilter 1, v(i, 1)

Perfect. That fixed it. Thanks!!!