0

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
4

1 回答 1

1

请参阅下面的代码（这是您添加偏移量的代码）。
Offset会让你从B2:M2增加到B3:M3asb 等等。
我替换了你的 row 和 col 变量，x因为你只能逐行移动。

转置（）

将 MyCell 作为范围调暗，将 MyRange 作为范围调暗
将 x 变暗

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

x = 0

对于 MyRange 中的每个 MyCell
    表格（“统计”）。选择
    Range("B2:M2").Offset(x, 0).Select
    选择.复制

    表格（MyCell.Value）.Select
    范围（“D2”）。选择
    Selection.PasteSpecial 粘贴：=xlPasteAll，操作：=xlNone，SkipBlanks：= _
    假，转置：=真

    x = x + 1

下一个 MyCell

结束子

你也可以试试这个：

将 MyCell、MyRange 调暗为范围
将 wb 调暗为工作簿
将 ws、wsTemp、wsStat 调暗为工作表
将 x 调暗为 Long

设置 wb = Thisworkbook
设置 ws = wb.Sheets("摘要")
设置 wsStat = wb.Sheets("Stats")

与 ws
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    设置 MyRange = .Range("A1:A" & lrow)
结束于

x = 0
对于 MyRange 中的每个 MyCell
    设置 wsTemp = wb.Sheets(MyCell.Value)
    wsStat.Range("B2:M2").Offset(x, 0).Copy
    wsTemp.Range("D2").PasteSpecial xlPasteAll, , , True
    x = x + 1
    设置 wsTemp = 无
下一个 MyCell

结束子

已经测试过了。
希望它能达到你想要达到的效果。

于 2013-11-06T06:12:18.843 回答