Question

我要做的是将来自多张纸张的信息整合到一张纸上。我在SO上看过其他帖子，但它们似乎对我不起作用。我试着做这样的事情：

Sub Copy_Data()
    Dim empt As Long
    Dim emptmas As Long

    For s = 2 To 8
        Set ws = Worksheets(2)
        For col = 1 To 25
            For row = 2 To 51

            empt = Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Select
            emptmas = empt + 1

            Worksheets(1).Cells(row, col).Value = Worksheets(s).Cells(emptmas, col).Value

            Next row
        Next col
    Next s

End Sub

但是当我运行代码时没有任何反应，甚至没有错误。我试着跑：

Worksheets(1).Cells(1, 1).Value = Worksheets(2).Cells(1, 1).Value

但即便如此也没有做任何事情。是否无法使用Cells（）函数从另一个工作表复制？

Answer 1

我现在没有时间为你完成此项工作，但希望其他人愿意或者它会让你朝着正确的方向前进。我稍后会回来查看。

Private Sub Copy_Data()
    Dim iIndex As Integer
    Dim ws As Excel.Worksheet
    Dim wsCopyFrom As Excel.Worksheet
    Dim r As Range

    'Set the worksheet where you are going to copy the data to.
    Set ws = ActiveWorkbook.Sheets("Sheet5")

    'Loop through the worksheets 
    For iIndex = = 2 To 8

        Set wsCopyFrom = Worksheets(iIndex)
        wsCopyFrom.Activate

        'Copy range "A2:Z51" from wsCopyFrom to
        'the bottom of ws

    Next iIndex
End Sub

Answer 2

未经测试，但我认为这就是您之后的事情：

Sub MacroMan()

Dim lastCell As Excel.Range

For i = 2 To 8
    With Sheets(i)    
        Set lastCell = .Cells.Find(What:="*", After:=.Cells(2, 1), Lookat:=xlPart, _
            LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
            MatchCase:=False)

        If Not lastCell Is Nothing Then 
            .Range(Cells(2, 1), lastCell).Copy Destination:=Sheets(1).Range("A" & _
                Sheets(1).Rows.Count).End(xlUp).Offset(1, 0)
        End If
    End With
Next i

End Sub

从多个其他工作表复制大量信息

2 个答案: