Excel VBA，从多个文件粘贴

我有这个代码的下列问题。 它不会运行，当我打开excel。

和

它不会从我的文件正确粘贴。 我希望它走到最后一行并粘贴我的信息，然后下一步，从第二个文件粘贴，等等。

有任何想法吗？

Private Sub Workbook_Open() Dim FolderPath As String Dim FileName As String FolderPath = "D:\excelprojekt\" FileName = Dir(FolderPath & "*.xlsx") Dim lastrow As Long Dim lastcolumn As Long Do While FileName <> "" Workbooks.Open (FolderPath & FileName) lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column Range(Cells(1, 1), Cells(lastrow, lastcolumn)).Copy Application.DisplayAlerts = False ActiveWorkbook.Close With ActiveSheet lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row ActiveCell.Offset(rowOffset:=2, columnOffset:=0).Activate ActiveSheet.PasteSpecial End With FileName = Dir Loop End Sub 

Answer 1

我认为在closures工作簿之后可以保留复制的数据，但这里没有理由这样做。 如果您符合工作簿引用的条件，则可以在两个工作簿都打开时从一个工作簿复制到另一个工作簿。 如果你知道你想要复制什么样的表单，你应该明确地引用它们，而不是使用ActiveSheet（我认为ActiveSheet将是当打开一个文件时上次保存的文件是活动的）

 Private Sub Workbook_Open() Dim FolderPath As String Dim FileName As String FolderPath = "D:\excelprojekt\" FileName = Dir(FolderPath & "*.xlsx") Dim lastrow As Long Dim lastcolumn As Long Dim wbOpened as Workbook Do While FileName <> "" Set wbOpened = Workbooks.Open(FolderPath & FileName) With wbOpened.ActiveSheet lastrow = .Cells(Rows.Count, 1).End(xlUp).Row lastcolumn = .Cells(1, Columns.Count).End(xlToLeft).Column .Range(.Cells(1, 1), .Cells(lastrow, lastcolumn)).Copy End With ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(2).PasteSpecial Application.DisplayAlerts = False wbOpened.Close FileName = Dir Loop End Sub