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