Question

我对此代码有以下问题。当我打开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

我认为在关闭工作簿后可以保留复制的数据，但这里没有理由这样做。如果您符合工作簿参考资格，则可以在两个工作簿都打开时从一个工作簿复制到另一个工作簿。如果你知道要复制哪些工作表，你应该明确地引用它们而不是使用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

Excel VBA，从多个文件粘贴

1 个答案: