VBA将单元格范围匹配到工作表名称，并将其复制/粘贴到相应的工作表

Question

I'm trying to write a macro that matches a cell in the with the sheet name and then pulls data from that sheet and then copies it in the next column with the initial sheet. Here's what I have so far:

Sub example() 

 Dim wkSht As Worksheet

  For Each wkSht In Sheets

    For Each Cell In Sheets("Reporting").Range("B2:B200")

        If Cell.Value = wkSht.Name Then

            On Error Resume Next

            wkSht.Range("D15").Copy Destination:=Sheets("Reporting").Range("c2:c36")

        End If

    Next Cell

 Next wkSht

End Sub

I want to do that for the whole column but I don't know the code for copying it in the next column over. Basically, it would match the Cell (B2) with the sheet tab name and then pull from the same cell in that respective tab and then copy to the next column (C2) . And I would do that for b3 , b4 , b5 , till b200 . Thanks!

Answer 1

I think I have understood your question. You would need a helper variable to increment as you copy data into a new column.

Code,

Sub example()

  Dim wkSht As Worksheet
  Dim i As Long

    i = 3
    For Each wkSht In Sheets

        For Each Cell In Sheets("Reporting").Range("B2:B200")

            If Cell = wkSht.Name Then

                On Error Resume Next
                Sheets("Reporting").Cells(2, i).Resize(35).Value = wkSht.Range("D15").Value
                i = i + 1

            End If

        Next Cell

    Next wkSht

End Sub

The use of the long variable i will allow you to store the position of the next avaliable column to enter data into.

Answer 2

You can use Offset() to specify a cell with a position relative to the cell in ColB:

Sub example() 

 Dim wkSht As Worksheet

  For Each wkSht In Sheets

    For Each Cell In Sheets("Reporting").Range("B2:B200")

        If Cell.Value = wkSht.Name Then

            wkSht.Range("D15").Copy Destination:=Cell.Offset(0,1)

        End If

    Next Cell

 Next wkSht

End Sub