A few words of thanks would be greatly appreciated.

Excel - Macro to create new workbook and copy data

It may not be feasible to carry out data operations manually as Excel workbooks often contain a large amount of data. Office software, like Excel , offers the option of Macros, which carry out data manipulation operations. It is easy to use a macro to create a new workbook and copy data. Through an efficiently written macro, the work can be accomplished within minutes without the possibility of any errors creeping in. It is not necessary to write a macro to create a new workbook and copy data from scratch, as previously written macros can be used after small changes are made to them. One can make the macro compatible with the workbook.

Issue
Solution

Issue

I need a macro for Excel that will copy rows from my spreadsheet into a new one if it meets certain criteria.

In the example below, I want to copy all of the rows that have "ab" in the second column to a new spreadsheet. I then want to repeat the process for the other values that appear in that column, therefore splitting the data into several different spreadsheets.

GP BR CUST_NO NAME day mo year     
I1 01 999999 SMITH 00 08 09     
I1 ab 999999 SMITH 04 08 09     
I1 cd 999999 SMITH 04 10 09     
I1 01 999999 SMITH 04 01 10     
I1 02 999999 SMITH 27 02 10     
I1 01 999999 SMITH 27 02 10     
I1 cd 999999 SMITH 02 03 10     
I1 cd 999999 SMITH 04 03 10     
I1 cd 999999 SMITH 30 07 09     
I1 ab 999999 SMITH 30 07 09     
I1 02 999999 SMITH 30 07 09

Solution

1. Make a backup of the spreadsheet
2. Open the work book
3. Press ALT + F11 to open VBE
4. Go to Insert > Module
5. Copy and paste the following code into the module:

Sub details()    

Dim thisWB  As String    

Dim newWB As String    

    thisWB = ActiveWorkbook.Name    
        
    On Error Resume Next    
    Sheets("tempsheet").Delete    
    On Error GoTo 0    
        
    Sheets.Add    
    ActiveSheet.Name = "tempsheet"    
        
    Sheets("Sheet1").Select    
        
    If ActiveSheet.AutoFilterMode Then    
        Cells.Select    
            
        On Error Resume Next    
            
        ActiveSheet.ShowAllData    
            
        On Error GoTo 0    
        
    End If    
        
    Columns("B:B").Select    
    Selection.Copy    
        
    Sheets("tempsheet").Select    
    Range("A1").Select    
    ActiveSheet.Paste    
    Application.CutCopyMode = False    
        
    If (Cells(1, 1) = "") Then    
        lastrow = Cells(1, 1).End(xlDown).Row    
            
        If lastrow <> Rows.Count Then    
            Range("A1:A" & lastrow - 1).Select    
            Selection.Delete Shift:=xlUp    
        End If    
        
    End If    
        
    Columns("A:A").Select    
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _    
                CopyToRange:=Range("B1"), Unique:=True    
        
    Columns("A:A").Delete    
        
    Cells.Select    
    Selection.Sort _    
            Key1:=Range("A2"), Order1:=xlAscending, _    
            Header:=xlYes, OrderCustom:=1, _    
            MatchCase:=False, Orientation:=xlTopToBottom, _    
            DataOption1:=xlSortNormal    
        
    lMaxSupp = Cells(Rows.Count, 1).End(xlUp).Row    
        
    For suppno = 2 To lMaxSupp    
        
        Windows(thisWB).Activate    

        supName = Sheets("tempsheet").Range("A" & suppno)    
            
        If supName <> "" Then    

            Workbooks.Add    
            ActiveWorkbook.SaveAs supName    
            newWB = ActiveWorkbook.Name    
                
            Windows(thisWB).Activate    

            Sheets("Sheet1").Select    
            Cells.Select    
                
            If ActiveSheet.AutoFilterMode = False Then    
                Selection.AutoFilter    
            End If    
                
            Selection.AutoFilter Field:=2, Criteria1:="=" & supName, _    
                        Operator:=xlAnd, Criteria2:="<>"    
                
            lastrow = Cells(Rows.Count, 2).End(xlUp).Row    

            Rows("1:" & lastrow).Copy    
                
            Windows(newWB).Activate    
            ActiveSheet.Paste    

            ActiveWorkbook.Save    
            ActiveWorkbook.Close    
                
        End If    
        
    Next    
        
    Sheets("tempsheet").Delete    
        
    Sheets("Sheet1").Select    
    If ActiveSheet.AutoFilterMode Then    
        Cells.Select    
        ActiveSheet.ShowAllData    
    End If    

End Sub