excel-宏-如何遍历行和单元格范围

Question

i've got a question.

I've got the names of sheets in my workbook in a sheet named "Summary". I've got some stats in a sheet called "Stats". I wanna loop over the names in summary sheet, select each sheet, then copy the values from B2:M2 from "stats" page, transpose copy it to column D2 in the sheet selected from "Summary" sheet. Then I want to move to next sheet from the list of sheets from "Summary" page, copy B3:M3 & copy as transpose the D2 column in the selected sheet & so forth.

I've managed to get this bit of code for it. It's not compelte. I'm unable to figure out how to increment from B2:M2 to B3:M3 to B4:M4 & so on.

Please can someone help me. I've never written VB code before.

Sub transpose() 
Dim MyCell As Range, MyRange As Range 
Dim row_counter As Long, col_counter As Long

Set MyRange = Sheets("Summary").Range("A1")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

row_counter = 2
col_counter = 2

For Each MyCell In MyRange
    Sheets("Stats").Select
    Range("B2:M2").Select
    Selection.Copy

    Sheets(MyCell.Value).Select
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, transpose:=True

    row_counter = row_counter + 1
    col_counter = col_counter + 1
Next MyCell

End Sub

Answer 1

See below code (which is your code with the addition of offset).
Offset will let you increment from B2:M2 to B3:M3 asb so on.
I replaced your row and col variable with just x since you only move by row.

Sub transpose() 

Dim MyCell As Range, MyRange As Range 
Dim x as long

Set MyRange = Sheets("Summary").Range("A1")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

x = 0

For Each MyCell In MyRange
    Sheets("Stats").Select
    Range("B2:M2").Offset(x, 0).Select
    Selection.Copy

    Sheets(MyCell.Value).Select
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, transpose:=True

    x = x + 1

Next MyCell

End Sub

Also you can try this:

Dim MyCell, MyRange as Range
Dim wb as Workbook
Dim ws, wsTemp, wsStat as Worksheet
Dim x as Long

Set wb = Thisworkbook
Set ws = wb.Sheets("Summary")
Set wsStat = wb.Sheets("Stats")

With ws
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    Set MyRange = .Range("A1:A" & lrow)
End With

x = 0
For Each MyCell in MyRange
    Set wsTemp = wb.Sheets(MyCell.Value)
    wsStat.Range("B2:M2").Offset(x, 0).Copy
    wsTemp.Range("D2").PasteSpecial xlPasteAll, , , True
    x = x + 1
    Set wsTemp = Nothing
Next MyCell

End Sub

Already Tested.
Hope it does what you want to achieve.