Search code examples
excelforeachcopy-pastevba

Loop and Copy/Paste all Rows equaling a variable into a new Excel File


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.

Here's an example of what I'm trying to do: enter image description here

The code is supposed to:

in a loop to check all Rows value of Prod.Type and If the checked row is 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, of course it will create a new Excel file for each produNum which prove to be true.

The result for prodNum = 2 should show only the header and the rows which equals 2

But the result I get is only the headers row getting paste

Here's the code I have made

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.

Thanks in advance for any help!


Solution

  • Your error is here:

    consh.Rows("A" & i).Copy wbtarget.Sheets(1).Range("A2")
    

    It should be not rows, but Range:

    consh.Range("A" & i).Copy wbtarget.Sheets(1).Range("A2")
    

    or without the A:

    consh.Rows(i).Copy wbtarget.Sheets(1).Range("A2")