在工作簿之间复制范围

我正在尝试将一个工作簿中工作表上的单元格范围复制到另一个工作簿中工作表的底部。 我一直在复制行上收到“应用程序定义或对象定义的错误”。

Dim NewFileName As String Dim BAHFileName As String NewFileName = "Filename" BAHFileName = "Other Filename" LastRow = Sheets("All").UsedRange.Rows.Count Workbooks(NewFileName).Sheets("All").Range(Cells(2, 1), Cells(LastRow, 15)).Copy Windows(BAHFileName & ".xlsx").Activate LastRow = Workbooks(BAHFileName).Sheets(1).UsedRange.Rows.Count + 1 Workbooks(BAHFileName).Sheets(1).Cells(LastRow, 1).Select ActiveSheet.Paste Application.CutCopyMode = False 

跟自己说话?

练习用这个代码避免使用select。

我不确定您的工作簿的情况,所以您将不得不相应地调整工作簿名称和工作表名称。

 Sub Button1_Click() Dim WB As Workbook Dim bk As Workbook Dim LastRow As Long Dim Lrow As Long Dim rng As Range Dim ws As Worksheet Dim sh As Worksheet Set WB = ThisWorkbook Set bk = Workbooks("MyWorkbook.xlsx") Set ws = WB.Sheets("All") Set sh = bk.Sheets(1) With ws LastRow = .UsedRange.Rows.Count Set rng = .Range(.Cells(2, 1), .Cells(LastRow, 15)) End With With sh Lrow = .UsedRange.Rows.Count + 1 rng.Copy .Cells(Lrow, 1) End With End Sub 

我需要在复制之前select表单。

 Dim NewFileName As String Dim BAHFileName As String NewFileName = "Filename" BAHFileName = "Other Filename" LastRow = Sheets("All").UsedRange.Rows.Count Sheets("All").Select Workbooks(NewFileName).Sheets("All").Range(Cells(2, 1), Cells(LastRow, 15)).Copy Windows(BAHFileName & ".xlsx").Activate LastRow = Workbooks(BAHFileName).Sheets(1).UsedRange.Rows.Count + 1 Workbooks(BAHFileName).Sheets(1).Cells(LastRow, 1).Select ActiveSheet.Paste Application.CutCopyMode = False