0

I am trying to create a program that will copy a row based on the value in column P into another sheet in the same workbook. Column P can be:

Design

Production

Process

Safety

Quality

Purchasing

I want the program to look at the Column P and if it says "design" then copy and paste that row into the sheet labeled "Design" and so on and so forth.

Can anyone help me?

Line

Set tosheet = Worksheets("" & fromsheet.Cells(r, "P"))

works fine initially then throw off an error of 'Run Time Error 9 after the first iteration.

Sub lars_ake_copy_rows_to_sheets()
Dim firstrow, lastrow, r, torow As Integer
Dim fromsheet, tosheet As Worksheet
firstrow = 2
Set fromsheet = ActiveSheet
lastrow = ActiveSheet.Cells(Rows.Count, "P").End(xlUp).Row
  For r = firstrow To lastrow
    If fromsheet.Cells(r, "P") <> "" Then  'skip rows where column P is empty
     On Error GoTo make_new_sheet
     Set tosheet = Worksheets("" & fromsheet.Cells(r, "P"))
     On Error GoTo 0
     GoTo copy_row
  make_new_sheet:
  Set tosheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
  tosheet.Name = fromsheet.Cells(r, "P")
copy_row:
  torow = tosheet.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
  fromsheet.Cells(r, 1).EntireRow.Copy
  tosheet.Cells(torow, 1).PasteSpecial Paste:=xlPasteValues
End If
Next r
 Application.CutCopyMode = False
 fromsheet.Activate

End Sub

I want this code to create new worksheet if already not created.

But this code create new sheet for only 1st record of column p which is design, if this sheet not created before but for the next record which is Production if the worksheet by the name of Production is not created before then this code throw an error of Run Time 9. Anyone who can fix this for me.

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
  • FYI, in `Dim firstrow, lastrow, r, torow As Integer`, firstrow, lastrow and r are Variant, and in `Dim fromsheet, tosheet As Worksheet` fromsheet is Variant. In vba each variable need its own "As xxxx". – Vincent G Nov 07 '19 at 08:43
  • You are not exiting the error handler after the first time you enter it. On the next error, since you are already in the error handler, it cannot trigger. – Vincent G Nov 07 '19 at 08:49

1 Answers1

0

As I mentioned in my comment, you are not properly handling the "Going out of the error handler". You can look Good Patterns For VBA Error Handling for some details on how handling errors.

This code should solve your problem (but I didn't test it)

Sub lars_ake_copy_rows_to_sheets()
    Dim firstrow As Long, lastrow As Long, r As Long, torow As Long
    Dim fromsheet As Worksheet, tosheet As Worksheet
    firstrow = 2
    Set fromsheet = ActiveSheet
    lastrow = ActiveSheet.Cells(Rows.Count, "P").End(xlUp).Row
    For r = firstrow To lastrow
        If fromsheet.Cells(r, "P") <> "" Then  'skip rows where column P is empty
            On Error GoTo make_new_sheet
            Set tosheet = Worksheets("" & fromsheet.Cells(r, "P"))
            On Error GoTo 0
            torow = tosheet.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
            fromsheet.Cells(r, 1).EntireRow.Copy
            tosheet.Cells(torow, 1).PasteSpecial Paste:=xlPasteValues
        End If
    Next r
    Application.CutCopyMode = False
    fromsheet.Activate
    Exit Sub
make_new_sheet:
    Set tosheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    tosheet.Name = fromsheet.Cells(r, "P")
    resume next
End Sub
Vincent G
  • 3,153
  • 1
  • 13
  • 30
  • I also corrected the remark from my first comment (and switched Integer to Long, there is no real reason to not use Long here) – Vincent G Nov 07 '19 at 08:57