find columns in other sheets and copy data loop

Question

ive got file with some sheets (master, 1, 2, 3).

below you can see the column in my master sheet - there are in order ID1 ID2 City OLT street number

i need to copy to my master file data from other sheets but first of all excel should find the ID1 column in other sheet (its a mess - there are not in order) and then copy rows. 1. find in sheet 1 column ID1 (A1) and then copy data to master sheet A2 2. find in sheet 1 column ID2 (B1) and the cop data to master sheet B2 Et cetera how could i do it in loop ?

Sub copy_data()

   Dim b As Range
      Dim lastrow As Integer
lastrow = Cells(Rows.Count, 3).End(xlUp).Row + 1

Set b = Sheets("1").Rows(1).Find("ID1")

If b Is Nothing Then

    MsgBox "ID1 not found", vbInformation, "Goods not found"

Else

    Set b = Range(b.Offset(1), b.Offset(Rows.Count - 1).End(xlUp))
    b.Copy Destination:=Sheets("master").Range("A" & lastrow)

End If
 'id
 Dim wrb As Range
 Set wrb = Sheets("1").Rows(1).Find("ID2")

If wrb Is Nothing Then

    MsgBox "id2 not found", vbInformation, "Goods not found"

Else

    Set wrb = Range(wrb.Offset(1), wrb.Offset(Rows.Count - 1).End(xlUp))
    wrb.Copy Destination:=Sheets("master").Range("B" & lastrow)
  End If
End Sub

i need to modyfy the code to search columns (from master file A1:Q1) in other sheets and copy data to master sheet. is way to loop it.

thanks for help

Apurv Pawar Apurv Pawar · Accepted Answer · 2017-08-18T15:12:59

try the below modification, let me know if this is what was expected output.

Sub copy_data()


   Dim b As Range
   Dim lastrow As Integer

   x = ThisWorkbook.Sheets.Count 'added
   j = 1
   Do While j <> x


lastrow = Cells(Rows.Count, 3).End(xlUp).Row + 1
lastrowM = Sheets("master").Cells(Rows.Count, 2).End(xlUp).Row + 1 'added

Set b = Sheets(j).Rows(1).Find("ID1")

If b Is Nothing Then

    MsgBox "ID1 not found", vbInformation, "Goods not found"

Else

    Set b = Range(b.Offset(1), b.Offset(Rows.Count - 1).End(xlUp))
    b.Copy Destination:=Sheets("master").Range("A" & lastrowM)

End If
 'id
 Dim wrb As Range
 Set wrb = Sheets(j).Rows(1).Find("ID2")

If wrb Is Nothing Then

    MsgBox "id2 not found", vbInformation, "Goods not found"

Else

    Set wrb = Range(wrb.Offset(1), wrb.Offset(Rows.Count - 1).End(xlUp))
    wrb.Copy Destination:=Sheets("master").Range("B" & lastrowM)
  End If
  j = j + 1
  Loop
End Sub

find columns in other sheets and copy data loop

1 Answers