无法迭代VBA Excel中的工作表和列
我目前在同一张工作表的78个工作表中的某一列中有数据，我想将其复制到另一个名为“工作表2”的工作表中。 本质上，我将78个工作表中的B3：B195中的数字，然后粘贴到“工作表2”中的一个列中，以便当子工作完成时，工作表2应该有78列，每个列有一个的工作表。 但是，当我运行macros没有发生在工作表中，当我走进macros，似乎只是跳过循环。
Sub TransferData() Dim numSheets As Long Dim columnsAcross As Long Dim lengthOfColumn As Long Dim columnCounter As Long Dim sht As Worksheet Dim y As String For numSheets = 2 To numSheets = 79 columnCounter = 1 For lengthOfColumn = 1 To lengthOfColumn = 192 y = "B" & (columnCounter + 3) Worksheets("Sheet 2").Range(Cells(lengthOfColumn, numSheets), Cells(lengthOfColumn, numSheets)) = Worksheets(numSheets).Range(y) columnCounter = columnCounter + 1 Next lengthOfColumn Next numSheets End Sub 未经testing
Sub Sample() Dim ws As Worksheet Dim i As Long Set ws = ThisWorkbook.Sheets(1) For i = 2 To 79 ThisWorkbook.Sheets(1).Range( _ Split(Cells(, i - 1).Address, "$")(1) & _ "2:" & _ Split(Cells(, i - 1).Address, "$")(1) & _ "195" _ ).Value = _ ThisWorkbook.Sheets(i).Range("B2:B195").Value Next i End Sub
跟随（从评论）
Sub Sample() Dim ws As Worksheet Dim i As Long Set ws = ThisWorkbook.Sheets(1) For i = 2 To 79 '~~> Get Values from A1 ThisWorkbook.Sheets(1).Range( _ Split(Cells(, i - 1).Address, "$")(1) & _ "1" _ ).Value = _ ThisWorkbook.Sheets(i).Range("A1").Value '~~> Get the column Values ThisWorkbook.Sheets(1).Range( _ Split(Cells(, i - 1).Address, "$")(1) & _ "2:" & _ Split(Cells(, i - 1).Address, "$")(1) & _ "195" _ ).Value = _ ThisWorkbook.Sheets(i).Range("B2:B195").Value Next i End Sub
Sub TransferData() Dim numSheets As Long Dim columnCounter As Long Dim wb As Workbook Set wb = ThisWorkbook columnCounter = 1 For numSheets = 2 To numSheets = 79 wb.Worksheets(numSheets).Range("B3:B195").Copy _ wb.Worksheets("Sheet 2").Cells(1, columnCounter) columnCounter = columnCounter + 1 Next numSheets End Sub
假设你有第二张纸（最后一张）
Sub Test() Dim ws As Worksheet Dim i As Long Set ws = ThisWorkbook.Sheets("Sheet 2") For i = 1 To 78 ws.Range("A1:A193").Offset(0, i - 1) = ThisWorkbook.Sheets(i).Range("B3:B195").Value Next i End Sub