I need help with Module to copy data and put into a new workbook

[sunshine23111]

Good morning! I have searched the Excel forum and either I am very poor at search criteria or no one but me has ever needed help with copying data based upon criteria and putting into a new workbook. I know that I can use the macro feature and do this, I actually did it with one of the names but, it seems like a lot to do for all of the names in there. This is something that I need to do on a monthly basis.

Basically, I am pulling bank statement data, putting that data into a workbook which is saved to my desktop. I want to then pull all the rows of data, by person, and put them into separate workbooks, saved to my desktop, so that I can email them out individually.

Thanks in advance for any help that you can provide.

 

[John_w]

Try this macro. Each new workbook is named after the Cardholder Name in column A.

Option Explicit

Public Sub Split_Sheet_By_Name()

    Dim destFolder As String
    Dim DistinctNames As Variant, DistinctName As Variant
    Dim filteredCells As Range
    Dim NameWorkbook As Workbook
    Dim AutoFilterWasOn As Boolean
    
    destFolder = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
    
    Application.ScreenUpdating = False
    
    With ActiveWorkbook.ActiveSheet
    
        AutoFilterWasOn = .AutoFilterMode
    
        DistinctNames = WorksheetFunction.Unique(.Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row))
        
        For Each DistinctName In DistinctNames
    
            'Filter on column A to show only rows for this Name

            .Range("A1").CurrentRegion.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria1:="=" & DistinctName
            Set filteredCells = .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
            
            'Copy filtered cells to new workbook
            
            Set NameWorkbook = Workbooks.Add(xlWBATWorksheet)
            filteredCells.Copy NameWorkbook.Worksheets(1).Range("A1")
            NameWorkbook.Worksheets(1).Range("A1").CurrentRegion.EntireColumn.AutoFit
            Application.DisplayAlerts = False 'suppress warning if file already exists
            NameWorkbook.SaveAs destFolder & DistinctName & ".xlsx", xlOpenXMLWorkbook
            Application.DisplayAlerts = True
            NameWorkbook.Close False
            
        Next
    
        'Restore autofilter if it was on
        
        .AutoFilter.ShowAllData
        If Not AutoFilterWasOn Then .AutoFilterMode = False
        
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "Done"

End Sub

 

[sunshine23111]

Try this macro. Each new workbook is named after the Cardholder Name in column A.

Option Explicit

Public Sub Split_Sheet_By_Name()

    Dim destFolder As String
    Dim DistinctNames As Variant, DistinctName As Variant
    Dim filteredCells As Range
    Dim NameWorkbook As Workbook
    Dim AutoFilterWasOn As Boolean
  
    destFolder = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
  
    Application.ScreenUpdating = False
  
    With ActiveWorkbook.ActiveSheet
  
        AutoFilterWasOn = .AutoFilterMode
  
        DistinctNames = WorksheetFunction.Unique(.Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row))
      
        For Each DistinctName In DistinctNames
  
            'Filter on column A to show only rows for this Name

            .Range("A1").CurrentRegion.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria1:="=" & DistinctName
            Set filteredCells = .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
          
            'Copy filtered cells to new workbook
          
            Set NameWorkbook = Workbooks.Add(xlWBATWorksheet)
            filteredCells.Copy NameWorkbook.Worksheets(1).Range("A1")
            NameWorkbook.Worksheets(1).Range("A1").CurrentRegion.EntireColumn.AutoFit
            Application.DisplayAlerts = False 'suppress warning if file already exists
            NameWorkbook.SaveAs destFolder & DistinctName & ".xlsx", xlOpenXMLWorkbook
            Application.DisplayAlerts = True
            NameWorkbook.Close False
          
        Next
  
        'Restore autofilter if it was on
      
        .AutoFilter.ShowAllData
        If Not AutoFilterWasOn Then .AutoFilterMode = False
      
    End With
  
    Application.ScreenUpdating = True
  
    MsgBox "Done"

End Sub

Hi John! Thanks so much for the work that you have put in on this! I copied this over and get the dreaded run-time error:

Run-time error '429'
Active component can't create object

It is occurring here: destFolder = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"

Is this piece trying to create a destination for the workbooks to go? I apologize if this is a dumb question but it is way out of my realm of knowledge for VBA.

 

[John_w]

That line gets the Desktop folder path and the error suggests Windows Script Host isn't installed or your user account doesn't have permission to use it.

Replace the line with:

    destFolder = Environ("USERPROFILE") & "\Desktop\"

 

[sunshine23111]

That line gets the Desktop folder path and the error suggests Windows Script Host isn't installed or your user account doesn't have permission to use it.

Replace the line with:

    destFolder = Environ("USERPROFILE") & "\Desktop\"

I received an error message and now everyth

 

[sunshine23111]

I received an error message and now everyth

Thank you so much! This works perfectly!!

 

[smozgur]

Thank you so much! This works perfectly!!

The marked solution has been changed accordingly - again. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers.
No further action is required for this thread. Please do not change the marked solution.