复制和粘贴excel数据从未打开的Excel工作表到目标Excel工作表到最后一行

Question

我正在尝试将数据从一个Excel工作表复制并粘贴到另一个工作表到最后一个可用行。我当前的代码覆盖了以前的数据。我想将数据添加到最后一行。请帮忙。

Sub CopyToExcel（）

Application.ScreenUpdating = False

Application.EnableEvents = False

WB_1 = ThisWorkbook.Name
WB_2 = "Analysis.xls"
b_file = "C:\\" & WB_2

On Error Resume Next
    Workbooks.Open (b_file)
If Err.Number <> 0 Then
    MsgBox ("Cannot find " & WB_2 & "-file!")
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
End If

t_max = Workbooks(WB_2).Sheets("Page 1").Cells(Rows.Count, 1).End(xlUp).Row
Workbooks(WB_2).Sheets("Page 1").Range("A1:R" & 100).Copy Destination:=Workbooks(WB_1).Sheets("DB2").Range("C1")
Workbooks(WB_2).Close SaveChanges:=False
Workbooks(WB_1).Activate

Application.EnableEvents = True
Application.ScreenUpdating = True
ActiveWorkbook.Save

End Sub

Answer 1

我没有看到你找到WB_1中的最后一行，我也不能看到你使用它吗？我的建议：使用对象。您可以更轻松地了解自己在做什么，并且可以更好地控制代码。

这是你在尝试什么？ （的未测试）

Sub CopyToExcel()
    Dim wbDest As Workbook, wbSource As Workbook
    Dim wsDest As Worksheet, wsSource As Worksheet
    Dim lRowDest As Long, lRowSource As Long

    '~~> This is the workbook where you want to copy
    Set wbDest = ThisWorkbook
    '~~> This is the worksheet where you want to copy
    Set wsDest = wbDest.Sheets("DB2")
    '~~> This is the last row where the data will be copied
    lRowDest = wsDest.Range("A" & wsDest.Rows.Count).End(xlUp).Row + 1

    '~~> This is the workbook FROM where you want to copy
    Set wbSource = Workbooks.Open("C:\Analysis.xls")
    '~~> This is the worksheet FROM where you want to copy
    Set wsSource = wbSource.Sheets("Page 1")

    With wsSource
        '~~> This is the last row till where the data will be copied from
        lRowSource = .Range("A" & .Rows.Count).End(xlUp).Row

        '~~> Do the final Copy
        .Range("A1:R" & lRowSource).Copy wsDest.Range("C" & lRowDest)
    End With

    wbSource.Close (False)
End Sub