Three sheets with code in sheet 1
Sheet 2 & 3 are identical data layout.
Want to loop through column K of sheet 2 & 3. (later there will be
sheets 2, 3, 4, 5 to loop through. Just 2 in this test example)

I have two problems.
The code does not error out BUT only returns the first value of sheet 2 to
sheet 1. The Loop does not loop. Every value in column K2 on down of the two loop sheets is greater than 1 in this test. (on finished project not all K values will be greater than 1)

The second problem are these lines.
The first line will grab a value from column C which will be one of eleven different Products. Product A through K. If it is "Product A" then it must go to
column D on sheet 1. If it is "Product G" then it must go to column L on sheet 1.

'Set prdCopy = wrkSheet.Range("C" & c.Row)
'prdPasteRow = Sheets(strConsTab).Cells(Rows.Count, "??").End(xlUp).Row + 1
'prdCopy.Copy Sheets(strConsTab).Range("??" & prdPasteRow)

The key for product-from loop to-column on sheet 1 is:

A to D, B to E, C to G, D to H, E to I, F to K,
G to L, H to M, I to O, j to P, K to Q.

Note that sheet 1 columns F, J & N are not used in this transfer key.
I have no clue how to make this work.

Thanks.
Howard

Option Explicit

Sub SheetTwoToFiveToOne()

Dim wrkSheet As Worksheet
Dim namCopy As Range
Dim prdCopy As Range

Dim zipCopy As Range
Dim namPasteRow As Long
Dim prdPasteRow2 As Long
Dim zipPasteRow As Long
Dim strConsTab As String
Dim c As Range

strConsTab = ActiveSheet.Name

Application.ScreenUpdating = False

For Each wrkSheet In ActiveWorkbook.Worksheets
If wrkSheet.Name < strConsTab Then
For Each c In Range("K2:K" & Range("K" & Rows.Count).End(xlUp).Row)
If c.Value < 1 Then

Set namCopy = wrkSheet.Range("A" & c.Row)
'Set prdCopy = wrkSheet.Range("C" & c.Row)
Set zipCopy = wrkSheet.Range("E" & c.Row)

namPasteRow = Sheets(strConsTab).Cells(Rows.Count, "A") _
.End(xlUp).Row + 1
'prdPasteRow = Sheets(strConsTab).Cells(Rows.Count, "??") _
.End(xlUp).Row + 1
zipPasteRow = Sheets(strConsTab).Cells(Rows.Count, "S") _
.End(xlUp).Row + 1

namCopy.Copy Sheets(strConsTab).Range("A" & namPasteRow)
'prdCopy.Copy Sheets(strConsTab).Range("??" & prdPasteRow)
zipCopy.Copy Sheets(strConsTab).Range("S" & zipPasteRow)

Application.CutCopyMode = False
End If
Next
End If
Next wrkSheet

Application.ScreenUpdating = True
End Sub