I am stuck i don't know what code to use so i can search the same column twice for 2 different keyword and then copy data from the same row to another spreadsheet in sequence from a start cell. for details here's what i am trying to do.

1. Limit the search within a range of the worksheet (ex. Sheet 1 B1:N:200)
2. Search the 8th column (I) of the limit range Sheet1 for keyword ("Goods")
3. Copy the data found in the 2nd (C) and 5th column (F) of same row where instance "Goods " is found
4. Paste Value of Sheet 1 - column 2 to Sheet2 - Column 3 (no format values only), and Sheet 1 column 5 to Sheet 2 Column4 (with format and values) on a specific starting point (ex. Sheet 2 - B3) Next Match Result will be Sheet 2 - B4 and so on

5.Search AGAIN the 8th column of Sheet1 for keyword ("Services") starting from the top (B1:N1)

6.Copy the data found in the 2nd (C) and 5th column (F) of same row where instance "Services" is found

7. Paste Value of Sheet 1 - column 2 to Sheet2 - Column 3 (no format values only), and Sheet 1 column 5 to Sheet 2 Column4 (with format and values) to next row after the last PASTE from "Goods" was done. (ex last row match paste was C35 and D35 new found value should be paste in C36 a D36) Ending Output should be all "Goods" results first then "Services" results

I hope i have conveyed what i need clearly

I am trying to work on this code that i found here but i just don't get how to insert the 2nd search loop for services., how to paste on specific cell in sheet2, how to follow the last row for services paste

    Sub CopyCells

Dim lngLastRowSht1 As Long

Dim lngLastRowSht2 As Long

Dim counterSht1 As Long
Dim counterSht2 As Long


With Worksheets(1)

    lngLastRowSht1 = .Cells(.Rows.Count, 8).End(xlUp).Row

    lngLastRowSht2 = Worksheets(2).Cells(Worksheets(2).Rows.Count, 5).End(xlUp).Row

        For counterSht1 = 1 To lngLastRowSht1

            For counterSht2 = 1 To lngLastRowSht2

                If Sheets(1).Range("" & (counterSht1)).Value = "Goods" Then

                    Sheets(2).Range("B" & (counterSht2), "D" & (counterSht2)).Value = Sheets(1).Range("C" & counterSht1, "D" & counterSht1).Value

                                    End If

            Next counterSht2

        Next counterSht1

        

End With

End Sub

Advance THANK YOU Internet peeps!

CodePudding user response：

You could make two routines: one for services and one for goods. But that code and the code above isn't very efficient.

Since Services & Goods are in the same column, try using the autofilter:

Sheets(2).UsedRange.autofilter Field:=8, Criteria1:=Array("Goods", "Services"), VisibleDropDown:=False, Operator:=xlFilterValues
Sheets(2).UsedRange.SpecialCells(xlCellTypeVisible).Copy
Sheets(1).Range("A1").PasteSpecial
Application.CutCopyMode = False

CodePudding user response：

Increment the target row after each copy.

Option Explicit
Sub CopyCells()

    Const ROW_START = 3

    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Dim n As Long, r As Long, lastrow1 As Long, lastrow2 as Long
    Dim keywords, word, t0 As Single: t0 = Timer
    keywords = Array("Goods", "Services")
    
    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets(1)
    Set ws2 = wb.Sheets(2)
    lastrow2 = ROW_START
    
    Application.ScreenUpdating = False
    With ws1
        lastrow1 = .Cells(.Rows.Count, "I").End(xlUp).Row
        For Each word In keywords
            For r = 1 To lastrow1
               If .Cells(r, "I") = word Then
                   'Sht1 col 2 to Sht2 Col 3 (no format values only)
                   'Sht1 col 5 to Sht2 Col 4 (with format and values)
                   ws2.Cells(lastrow2, "C") = .Cells(r, "B")
                   ws2.Cells(lastrow2, "D") = .Cells(r, "E")
                   .Cells(r, "E").Copy
                   ws2.Cells(lastrow2, "D").PasteSpecial xlPasteFormats
                   lastrow2 = lastrow2   1
                   n = n   1
               End If
            Next
        Next
    End With
    Application.ScreenUpdating = True
    
    MsgBox lastrow1 & " rows scanned " & vbLf & n & " rows copied", _
    vbInformation, Format(Timer - t0, "0.0 secs")
End Sub