Loop Thru Rows - Copy / Paste Other Sheet

Sub cpypste()
    
    Dim x         As Long
    Dim ws1       As Worksheet: Set ws1 = ThisWorkbook.Sheets("Main Data")
    Dim ws2       As Worksheet: Set ws2 = ThisWorkbook.Sheets("Group 2 Printout")
    
    Do
        DoEvents
        x = Application.InputBox("Enter Group Number (1 or 2): ", "Search Group ", Type:=1)
        If x = 0 Then Exit Sub    'User canceled
        If x <> 1 Or x <> 2 Then Exit Do Else MsgBox "Please enter a 1 or 2.", vbExclamation, "Invalid Entry"
    Loop
    
    If ws2.Range("A" & Rows.Count).End(xlUp).Row > 2 Then ws2.UsedRange.Offset(2).Clear
    
    If Not IsError(Application.Match(x, ws1.Range("A:A"), 0)) Then
    
        ws1.Range("A3").CurrentRegion.AutoFilter Field:=1, Criteria1:=x
        Intersect(ws1.AutoFilter.Range.Offset(1), ws1.Range("B:F,L:L")).Copy _
            Destination:=ws2.Range("A" & Rows.Count).End(xlUp).Offset(1)
        ws1.AutoFilterMode = False
        
    Else
        MsgBox "No match found for: " & x, vbExclamation, "Copy Canceled"
    End If
    
End Sub

Originally Posted by Logit

.
AlphaFrog

Thank you for the assistance.

I know you won't believe me but I was going to try your macro the very next thing ....

( ya .. right )


Thank you. I DO appreciate the help.

You're welcome.

Minor bug fix. Change this line...

        If x = 1 Or x = 2 Then Exit Do Else MsgBox "Please enter a 1 or 2.", vbExclamation, "Invalid Entry"

You omitted your Do Loop for the FindNext.
After 'FirstAddress' line

Do
    'your if statements and Set statement
Loop While rngC.Address <> FirstAddress

Is it what you need ?

Sub cpypste1()
Dim rngC As Range
Dim i As Integer
Dim DstLR As Integer
Dim OrgLR  As Integer
Dim x As String
Dim strLastRow As String
Dim strToFind As String, FirstAddress As String
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Main Data")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Group 2 Printout")
Const FR = 3


    x = InputBox("Enter Group Number (1 or 2): ", "Search Group ")
    With ws1
        OrgLR = .Cells(Rows.Count, "A").End(3).Row
        For i = FR To OrgLR
            If .Cells(i, 1) = x Then
                DstLR = ws2.Range("A" & Rows.Count).End(xlUp).Row
                .Cells(i, 2).Copy ws2.Cells(DstLR + 1, 1)
                .Cells(i, 3).Copy ws2.Cells(DstLR + 1, 2)
                .Cells(i, 4).Copy ws2.Cells(DstLR + 1, 3)
                .Cells(i, 5).Copy ws2.Cells(DstLR + 1, 4)
                .Cells(i, 6).Copy ws2.Cells(DstLR + 1, 5)
                .Cells(i, 12).Copy ws2.Cells(DstLR + 1, 6): ws2.Cells(DstLR + 1, 6) = .Cells(i, 12)
            End If
        Next i
    End With
End Sub

Sub Test()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Main Data")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Group 2 Printout")

strValueToPick = InputBox("Enter Group Number (1 or 2): ", "Search Group ")

strLastRow = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1

    With ws1.Range("A3:A100")
        Set rngFind = .Find(strValueToPick, .Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole)
        If Not rngFind Is Nothing Then
            strFirstAddress = rngFind.Address
            Set rngpicked = rngFind.Offset(0, 1).Resize(, 5)
            Set rngpicked2 = rngFind.Offset(0, 11)

            Do
                Set rngpicked = Union(rngpicked, rngFind.Offset(0, 1).Resize(, 5))
                Set rngpicked2 = Union(rngpicked2, rngFind.Offset(0, 11))
                
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstAddress
        End If
    End With
    
    If rngpicked Is Nothing Then Exit Sub

   rngpicked.Copy Destination:=ws2.Cells(strLastRow, 1)
   rngpicked2.Copy Destination:=ws2.Cells(strLastRow, 6)

End Sub