Pasting Rows from one Table to another

[b4tmast]

I have Table1 with 17 columns and several hundred rows. I am trying to paste specific rows in a specific order to Table2 - they must always be in specific rows on Table2 (see code/spreadsheet). My problem is that on Table2 I need to have an index column on the left (for other spreadsheets in the program). I can't get it to paste one column over. It keeps pasting to the left column like Table1. I've tried different methods and still the same results. Any suggestions? Also, the method that I'm using to paste to Table2 seems very sloppy, inefficent and crude - I could use helpful suggestions. Oh yeah, I'm a complete newbie. Thanks in advance.

Option Explicit


Sub PopulateSheet2()


Dim wsh As Worksheet
Dim wsh2 As Worksheet
Dim i As Long
Dim Lr As Long
Dim Table2 As Object
' Initalize variables
Set wsh = Sheets("Sheet1")
Set wsh2 = Sheets("Sheet2")




With Sheets("Sheet1")
    Lr = .Range("B2").End(xlDown).Row
    
    For i = 2 To Lr
        If .Cells(i, "D") = "Master" And .Cells(i, "E") Like "*Active*" Then
         '  wsh.Range("Table1").AdvancedFilter Action:=xlFilterCopy, _
          '      CriteriaRange:=wsh.Rows(i), CopytoRange:=wsh2.Range("B2:R2"), Unique:=False
            wsh.Rows(i).Copy Destination:=wsh2.Rows(2)
        End If
        If .Cells(i, "D") Like "*Chief Mate*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy Destination:=wsh2.Rows(3)
        End If
        If .Cells(i, "D") Like "*Second Mate*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(4)
        End If
        If .Cells(i, "D") = "Third Mate" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(5)
        End If
        If .Cells(i, "D") = "Third Mate RO" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(6)
        End If
        If .Cells(i, "D") Like "*Bosun AB*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(7)
        End If
        If .Cells(i, "D") Like "*AB Deck Maintenance (1)*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(8)
        End If
        If .Cells(i, "D") Like "*AB Deck Maintenance (2)*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(9)
        End If
        If .Cells(i, "D") Like "*AB Watch 8X12*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(10)
        End If
        If .Cells(i, "D") Like "*AB Watch 12x4*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(11)
        End If
        If .Cells(i, "D") Like "*AB Watch 4x8*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(12)
        End If
        If .Cells(i, "D") Like "*Chief Engineer*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(13)
        End If
        If .Cells(i, "D") Like "*First Engineer*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(14)
        End If
        If .Cells(i, "D") Like "*Second Engineer*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(15)
        End If
        If .Cells(i, "D") Like "*Third Engineer*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(16)
        End If
        If .Cells(i, "D") Like "*Deck Engine Utility (1)*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(17)
        End If
        If .Cells(i, "D") Like "*Deck Engine Utility (2)*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(18)
        End If
        If .Cells(i, "D") Like "*Steward Baker*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(19)
        End If
        If .Cells(i, "D") Like "*Chief Cook*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(20)
        End If
        If .Cells(i, "D") Like "*Steward Assistant*" And .Cells(i, "E") Like "*Active*" Then
            wsh.Rows(i).Copy wsh2.Rows(21)
        End If
        
        ' Seems very inefficient, slow and sloppy...
Next i
End With


End Sub

[b4tmast]

Sorry guys...

[b4tmast]

Solved!

This is the best code I could come up with. Any suggestions for making it more efficient, less bulky, etc. would be appreciated. Thanks.

Sub CopyRows()


Dim wsh As Worksheet
Dim wsh2 As Worksheet
Dim i As Long
Dim Lr As Long


' Initalize variables
Set wsh = Sheets("Sheet1")
Set wsh2 = Sheets("Sheet2")
    
With Sheets("Sheet1")
    Sheets("Sheet1").Select
    ' Find the last row of data
    Lr = .Range("B2").End(xlDown).Row
    ' Loop through each row
    For i = 2 To Lr
        ' Decide if to copy based on column C & D
        If .Cells(i, "C") = "Master" And .Cells(i, "D") Like "*Active*" Then
            .Cells(i, 1).Resize(1, 17).Copy
            Sheets("Sheet2").Select
            Sheets("Sheet2").Range("B2").Select
            ActiveSheet.Paste
        End If
        If .Cells(i, "C") Like "*Chief Mate*" And .Cells(i, "D") Like "*Active*" Then
           .Cells(i, 1).Resize(1, 17).Copy
            Sheets("Sheet2").Select
            Sheets("Sheet2").Range("B3").Select
            ActiveSheet.Paste
        End If
        If .Cells(i, "C") Like "*Second Mate*" And .Cells(i, "D") Like "*Active*" Then
           .Cells(i, 1).Resize(1, 17).Copy
            Sheets("Sheet2").Select
            Sheets("Sheet2").Range("B4").Select
            ActiveSheet.Paste
        End If
        If .Cells(i, "C") = "Third Mate RO" And .Cells(i, "D") Like "*Active*" Then
            .Cells(i, 1).Resize(1, 17).Copy
            Sheets("Sheet2").Select
            Sheets("Sheet2").Range("B5").Select
            ActiveSheet.Paste
        End If
        If .Cells(i, "C") = "Third Mate" And .Cells(i, "D") Like "*Active*" Then
            .Cells(i, 1).Resize(1, 17).Copy
            Sheets("Sheet2").Select
            Sheets("Sheet2").Range("B6").Select
            ActiveSheet.Paste
        End If
        'sloppy, but, it's the best I could come up with...
        
        
    Next i
End With
End Sub