Niggy Yeap
New Member
- Joined
- Apr 11, 2022
- Messages
- 2
- Office Version
- 2019
- Platform
- Windows
HI ALL, I am currently creating a VBA macro to help my colleague to make their repetitive copy and paste work easier and faster.
So here's how my macro should work. Before I run a macro, I need to manually generate a column, that column contains a list of unique value Vendor Name.
This Vendor Name is originally from the table of data (the first row to be more specific).
The loop will look at this manually created column first, then it use the first value it gets to filter the whole table(this column does not have any header).
It will filter all the date in the table, using ActiveCell.Value as a Criteria1. This the drafted code I make. It won't work as I expexted, as help are appreciated.
Sub loop_filter()
Dim x As Integer
NumRows = Range("L2", Range("L2").End(xlDown)).Rows.Count
Range("L2").Select 'Select first data
For x = 1 To NumRows
Cells.Select
Selection.AutoFilter
ActiveSheet.Range("$A:$J").AutoFilter Field:=1, Criteria1:=NumRows.ActiveCell
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\Easy IT Team\Desktop\Test\" + NumRows.ActiveCell.Value + ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
ActiveCell.Offset(1, 0).Select
Next
End Sub
So here's how my macro should work. Before I run a macro, I need to manually generate a column, that column contains a list of unique value Vendor Name.
This Vendor Name is originally from the table of data (the first row to be more specific).
The loop will look at this manually created column first, then it use the first value it gets to filter the whole table(this column does not have any header).
It will filter all the date in the table, using ActiveCell.Value as a Criteria1. This the drafted code I make. It won't work as I expexted, as help are appreciated.
VBA Code:
Dim x As Integer
NumRows = Range("L2", Range("L2").End(xlDown)).Rows.Count
Range("L2").Select 'Select first data
For x = 1 To NumRows
Cells.Select
Selection.AutoFilter
ActiveSheet.Range("$A:$J").AutoFilter Field:=1, Criteria1:=NumRows.ActiveCell
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\Easy IT Team\Desktop\Test\" + NumRows.ActiveCell.Value + ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
ActiveCell.Offset(1, 0).Select
Next
End Sub
VBA Code: