Here is one way that will hopefully do what you need and be easy enough to understand so you can adapt it to your workbook.
Sub MoveData()
Dim LOSource As ListObject: Set LOSource = Sheets("Form1").ListObjects(1)
Dim LOTarget As ListObject: Set LOTarget = Sheets("Sheet2").ListObjects(1)
Dim LRSource As ListRow: Set LRSource = LOSource.ListRows(LOSource.ListRows.Count)
Dim LRTarget As ListRow
Dim i As Integer
With LOSource
For i = 8 To 23 Step 2
If .Range(.ListRows.Count + 1, i) = "Yes" Then
Set LRTarget = LOTarget.ListRows.Add
LRTarget.Range(1) = LRSource.Range(5)
LRTarget.Range(2) = LRSource.Range(i).Offset(, 1)
LRTarget.Range(3) = LRSource.Range(27)
LRTarget.Range(4) = LRSource.Range(6)
LRTarget.Range(5) = LRSource.Range(7)
End If
Next i
End With
End Sub
BSB
Bookmarks