Hi everyone,
I'm new to vba so will really appreciate any help .
After a long unfruitful search I can't find why my code won't work.
To explain the problem, I have an Excel File with a bunch of data sorted by an index called Prod.Type in column A
<tbody>
</tbody>
And my code is supposed to :
in a loop to check all Rows value of Prod.Type and
if it equals the variable prodNum then it copy the row into a new excel file.
else it close the file and increment prodNum and loop again until the whole column has been checked.
The result should be like this for prodNum = 2
<tbody>
</tbody>
But the result I get is only the headers row getting paste
Here's the code I have made
The "For counter = 1 To 20" is for testing purpose, I have more than 6000 rows of data to copy paste.
I'm new to vba so will really appreciate any help .
After a long unfruitful search I can't find why my code won't work.
To explain the problem, I have an Excel File with a bunch of data sorted by an index called Prod.Type in column A
Prod.Type | Name | Price | Nb.Stock |
2 | Fries | 4 | 100 |
2 | Roasted Potato | 2 | 50 |
3 | Computer | 700 | 30 |
4 | Paper | 1 | 500 |
4 | Binder | 2 | 200 |
7 | Chair | 40 | 7 |
9 | Bag | 50 | 20 |
9 | Panier | 50 | 20 |
<tbody>
</tbody>
And my code is supposed to :
in a loop to check all Rows value of Prod.Type and
if it equals the variable prodNum then it copy the row into a new excel file.
else it close the file and increment prodNum and loop again until the whole column has been checked.
The result should be like this for prodNum = 2
Prod.Type | Name | Price | Nb.Stack |
2 | Fries | 4 | 100 |
2 | Roasted Potato | 2 | 50 |
<tbody>
</tbody>
But the result I get is only the headers row getting paste
Here's the code I have made
Code:
Sub test()
Dim wbtarget As Excel.Workbook
Dim consh As Worksheet
Dim prodNum As Long
Dim i As Long
Dim shnum As Long
Set consh = ThisWorkbook.Sheets("Sheet1")
For counter = 1 To 20
Set wbtarget = Workbooks.Add
consh.Rows(1).Copy wbtarget.Sheets(1).Range("A1")
For i = 1 To ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If Range("A" & i).Value = prodNum Then
consh.Rows("A" & i).Copy wbtarget.Sheets(1).Range("A2")
Else
wbtarget.SaveAs "C:\Users\Anon\Desktop\Project\" & shnum & ".xlsx" 'path to save file
prodNum = prodNum + 1
shnum = shnum + 1
End If
Next
Next counter
End Sub
The "For counter = 1 To 20" is for testing purpose, I have more than 6000 rows of data to copy paste.