Filter & Copy, Paste Data in New Excel File From Branch List Sheet & Save That Same in Folder with VBA Loop

[aarifar08]

I want to filter and split the data based on branch name (Branch List sheet), and also want to save that new excel workbook for each branch as per the same name as mentioned in the Branch List sheet. Please help me with LOOP function to complete my code.

 

[John_w]

Please help me with LOOP function to complete my code.

Post your code.

The code here fulfills a similar request to yours and shows how to loop through distinct 'names', filtering the sheet by each name and saving the visible rows to a new workbook on the Desktop. It should be easily adaptable to your request.

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

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...

www.mrexcel.com

 

[aarifar08]

Post your code.

The code here fulfills a similar request to yours and shows how to loop through distinct 'names', filtering the sheet by each name and saving the visible rows to a new workbook on the Desktop. It should be easily adaptable to your request.

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

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...

www.mrexcel.com

Below my Code:

Sub Split_Branch()

Range(Selection, Selection.End(xlToRight)).Select

Range(Selection, Selection.End(xlDown)).Select

Selection.AutoFilter

Sheets("Branch_List").Select

Range("B2").Select

ActiveCell.FormulaR1C1 = "AMALNER SME"

Sheets("All Products Due List").Select

Range("B1").Select

ActiveSheet.Range("$A$1:$AL$500000").AutoFilter Field:=2, Criteria1:= _

"AMALNER SME"

Selection.End(xlToLeft).Select

Range(Selection, Selection.End(xlToRight)).Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Copy

Workbooks.Add

ActiveSheet.Paste

Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

Selection.Columns.AutoFit

Range("A2").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "1"

Range("A3").Select

ActiveCell.FormulaR1C1 = "=R[-1]C+1"

Range("A3").Select

Selection.Copy

Range(Selection, Selection.End(xlDown)).Select

Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

Range("B2").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "AMALNER SME"

Range("A1").Select

ChDir "C:\Users\hp\Desktop\@Split Branch"

ActiveWorkbook.SaveAs Filename:= _

"C:\Users\hp\Desktop\@Split Branch\AMALNER SME.xlsx", FileFormat:= _

xlOpenXMLWorkbook, CreateBackup:=False

ActiveWindow.Close



End Sub

 

[John_w]

Try this macro. It assumes the branch names are in the "Branch_List" sheet in column A starting at A2 and there are no duplicates.

Public Sub Split_Sheet_By_Branches()
    
    Dim destFolder As String
    Dim Branches As Variant, Branch As Variant
    Dim filteredCells As Range
    Dim BranchWorkbook As Workbook
    Dim AutoFilterWasOn As Boolean
    
    destFolder = "C:\Users\hp\Desktop\@Split Branch\"
    
    With ActiveWorkbook.Worksheets("Branch_List")
        Branches = Application.WorksheetFunction.Transpose(.Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value)
    End With
    
    Application.ScreenUpdating = False

    With ActiveWorkbook.Worksheets("All Products Due List")
    
        For Each Branch In Branches
    
            'Filter on column B to show only rows for this Branch

            .UsedRange.AutoFilter Field:=2, Operator:=xlFilterValues, Criteria1:="=" & Branch
            Set filteredCells = .UsedRange.SpecialCells(xlCellTypeVisible)
            
            'Copy filtered cells to new workbook and put 1, 2, 3... number series in column A
            
            Set BranchWorkbook = Workbooks.Add(xlWBATWorksheet)
            filteredCells.Copy BranchWorkbook.Worksheets(1).Range("A1")
            With BranchWorkbook.Worksheets(1)
                .Range("A2").Value = 1
                With .Range("A2", .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row))
                    .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
                End With
            End With
            BranchWorkbook.Worksheets(1).Range("A1").CurrentRegion.EntireColumn.AutoFit
            Application.DisplayAlerts = False 'suppress warning if file already exists
            BranchWorkbook.SaveAs destFolder & Branch & ".xlsx", xlOpenXMLWorkbook
            Application.DisplayAlerts = True
            BranchWorkbook.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