CODEWITHSUNDEEP
vbaexcel
ante011
ante011

Reputation: 99

Excel VBA, paste from multiple files

I have following issues with this code. it wont run when i open excel.

And

It will not paste from my files correctly. i want it to step to the last row and paste my info, then step down and paste from the second file, and so on.

any ideas? 

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

Upvotes: 0

Views: 61

Answers (1)

Wedge
Wedge

Reputation: 1826

I think it's possible to maintain copied data after closing a workbook, but there's no reason to do that here. If you qualify your workbook references you can copy from one workbook to another while both are open. If you know what sheets you want to be copying from and into, you should probably explicitly reference them instead of using ActiveSheet as well (I think ActiveSheet will be whatever sheet was active when the file was last saved when opening a file)

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

Upvotes: 1

Related Questions