excel - Macro - 如何迭代行和&一系列细胞

时间:2013-11-06 05:32:13

标签: excel excel-vba vba

我有一个问题。

我的工作簿中有一张名为“摘要”的工作表中的工作表名称。我在一张名为“Stats”的表格中有一些统计数据。我想在摘要表中循环显示名称,选择每个工作表,然后从“统计数据”页面复制B2:M2中的值,将其转置复制到从“摘要”工作表中选择的工作表中的列D2。然后我想从“摘要”页面的表格列表中移动到下一页,复制B3:M3&复制为转置所选工作表中的D2列&等等。

我已经设法为它获取了这段代码。这不是强制性的。我无法弄清楚如何从B2:M2增加到B3:M3B4:M4&等等。

请有人帮助我。我以前从未编写过VB代码。

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

1 个答案:

答案 0 :(得分:1)

见下面的代码(这是你添加偏移量的代码) Offset允许您从B2:M2增加到B3:M3 asb等 我只用x替换了你的row和col变量,因为你只是按行移动。

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

你也可以试试这个:

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

已经测试过。
希望它能实现您想要实现的目标。