Sub ExtractToNewWorkbook()
Dim ws As Worksheet
Dim wsNew As Workbook
Dim rData As Range
Dim rfl As Range
Dim state As String
Dim sfilename As String
Set ws = ThisWorkbook.Sheets("emp")
'Apply advance filter in your sheet
With ws
Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 11).End(xlUp))
.Columns(.Columns.Count).Clear
.Range(.Cells(2, 6), .Cells(.Rows.Count, 6).End(xlUp)).AdvancedFilter
Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True
For Each rfl In .Range(.Cells(1, .Columns.Count), .Cells(.Rows.Count,
.Columns.Count).End(xlUp))
state = rfl.Text
Set wsNew = Workbooks.Add
sfilename = state & ".xlsx"
'Set the Location
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sfilename
Application.DisplayAlerts = False
ws.Activate
rData.AutoFilter Field:=6, Criteria1:=state
rData.Copy
Windows(state).Activate
ActiveSheet.Paste
ActiveWorkbook.Close SaveChanges:=True
Next rfl
Application.DisplayAlerts = True
End With
ws.Columns(Columns.Count).ClearContents
rData.AutoFilter
End Sub
-----------------------
Topic: Split a master tab into multiple sub tabs with 1 click
Scenario: You want to split the data on a master file into multiple small sub-tabs
by a chosen criteria (eg. Department, Country, etc.)
Function: Macro for Copy sheet, AutoFilter, and Loop
***Macro Code SEE COMMENT FOR IMPORTANT NOTICE***
Sub SplitandFilterSheet()
'Step 1 - Name your ranges and Copy sheet
'Step 2 - Filter by Department and delete rows not applicable
'Step 3 - Loop until the end of the list
Dim Splitcode As Range
Sheets("Master").Select
Set Splitcode = Range("Splitcode")
For Each cell In Splitcode
Sheets("Master").Copy After:=Worksheets(Sheets.Count)
ActiveSheet.Name = cell.Value
With ActiveWorkbook.Sheets(cell.Value).Range("MasterData")
.AutoFilter Field:=6, Criteria1:="NOT EQUAL TO" & cell.Value,
Operator:=xlFilterValues
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
ActiveSheet.AutoFilter.ShowAllData
Next cell
End Sub
---------------------
Sub copyDatabyCondition()
�copy data if column S isn�t empty
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim gSourceRow As Long, gSourceTotal As Long
Dim gTargetRow As Long
�intialization
Set wsSource = ThisWorkbook.Sheets(�INPUT�)
Set wsTarget = ThisWorkbook.Sheets(�Sheet2�)
�find the last row in both tables
gTargetRow = wsTarget.[A65536].End(xlUp).Row
With wsSource
�for each row in the source table
For gSourceRow = 11 To .[A65536].End(xlUp).Row
�column S isn�t empty?
If .Cells(gSourceRow, �S�) 0 Then
gTargetRow = gTargetRow + 1 �increment row no. & appending a new line
�copying a line from source table to target table
wsTarget.Range(�A� & gTargetRow & �:N� & gTargetRow).Value = _
.Range(�L� & gSourceRow & �:Y� & gSourceRow).Value
End If
Next
End With
End Sub
---------------------
Sub copycolumns()
Dim lastrow As Long, erow As Long
lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
If Sheet1.Cells(i, 6) = �Maharashtra� Then
Sheet1.Cells(i, 1).Copy
erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheet1.Paste Destination:=Worksheets(�Sheet2�).Cells(erow, 1)
Sheet1.Cells(i, 3).Copy
Sheet1.Paste Destination:=Worksheets(�Sheet2�).Cells(erow, 2)
Sheet1.Cells(i, 6).Copy
Sheet1.Paste Destination:=Worksheets(�Sheet2�).Cells(erow, 3)
End If
Next i
Application.CutCopyMode = False
Sheet2.Columns().AutoFit
Range(�A1�).Select
End Sub
--------------
Sub Splitziez()
Dim strPath As String
strPath = "Location of your file"
For Each sheetz0r In ThisWorkbook.Sheets
sheetz0r.Copy
Application.ActiveWorkbook.SaveAs Filename:=strPath & "\" & sheetz0r.Name &
".xlsx"
Application.ActiveWorkbook.Close False
Next
End Sub
-------------
I need a macro for following condition
suppose i have customer excel file in which first 7 rows is for header so, from 8th
rowrecords are start
i need to split rows of 500 record each in one file and save them with name
customer1,customer2,customer3,........
suppose i have customer file of 2540 records so it split in
customer1 which have header rows with record starts from 8th row to 507th row
customer2 which have header rows with record starts from 508th row to 1007th row
customer3 which have header rows with record starts from 1008th row to 1507th row
customer4 which have header rows with record starts from 1508th row to 2007th row
customer5 which have header rows with record starts from 2008th row to 2507th row
customer6 which have header rows with record starts from 2508th row to 2540th row
