Question

我目前在同一工作表中的78个工作表中的某个列中有数据，我想将其复制到我的工作簿中标题为“工作表2”的另一个工作表中。实质上我在78个工作表的每一个中取出范围B3：B195中的数字，然后将其粘贴到“工作表2”中的一列中，这样当子工作完成时，工作表2应该有78列，每列有一个数据。工作表。但是，当我运行宏时，工作表中没有任何反应，当我进入宏时，似乎只是跳过了循环。

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

Answer 1

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

Answer 2

未测试

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

Answer 3

假设您在后面有纸张2（最后一张纸）

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

无法在VBA Excel中迭代工作表和列

3 个答案: