我有一个问题。
我的工作簿中有一张名为“摘要”的工作表中的工作表名称。我在一张名为“Stats”的表格中有一些统计数据。我想在摘要表中循环显示名称,选择每个工作表,然后从“统计数据”页面复制B2:M2中的值,将其转置复制到从“摘要”工作表中选择的工作表中的列D2。然后我想从“摘要”页面的表格列表中移动到下一页,复制B3:M3&复制为转置所选工作表中的D2列&等等。
我已经设法为它获取了这段代码。这不是强制性的。我无法弄清楚如何从B2:M2
增加到B3:M3
到B4: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
答案 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
已经测试过。
希望它能实现您想要实现的目标。