I'm new to VBA. I found this code on a youtube video to copy data from Multiple Workbooks into Master, which is what I want to do. However, I get a compile error: Invalid or unqualified reference when it gets to "*.xlsx" It does not like the period: Help gives me this: An identifier beginning with a period is valid only within a With block. This error has the following cause and solution:
The identifier begins with a period.
Complete the qualification of the identifier or remove the period.
Any suggestions?
Sub copyDataFromMultipleWorkbooksIntoMaster()
Dim FolderPath As String, Filepath As String, Filename As String
FolderPath = "G:\control_chart\"
Filepath = FolderPath & “ * .xlsx”
Filename = Dir(Filepath)
Dim lastrow As Long, 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(2, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
ActiveSheet.Paste Destination:=Worksheets(“Sheet1”).Range(Cells(erow, 1), Cells(erow, lastcolumn))
ActiveSheet.Paste Destination:=Worksheets(“Sheet1”).Range(Cells(erow, 1), Cells(erow, 4))
Filename = Dir
Loop
End Sub
Related
I am receiving a message stating excel cannot find a file located in the path noted below. The file is in the folder and I have no idea how to fix this.
This is my first macro, any help would greatly be appreciated.
Sub CodeDateData()
Dim MyFile As String
MyFile = Dir("I:\MAR_Public\LOGISTICS CDA\LCL Data\Reference Lists PERM99\LCL Inventory Reports for Spotfire\")
Dim lastrow As Long, lastcolmn As Long
Do While Len(MyFile) > 0
If MyFile = "ZZ Spotfire Inv File.xlsm" Then
Exit Sub
End If
Workbooks.Open (MyFile)
Sheets("Code Date").Select
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Code Date").Range(Cells(erow, 1), Cells(erow, 4))
MyFile = Dir
Loop
Application.DisplayAlerts = True
End Sub
I have 7 productivity files which I need to copy the data from the sheet titled worktracker and paste these in the worktracker sheet in the masterfile, but I'm getting:
Run-time error 1004
Method Range of object_Worksheet failed.
Private Sub CommandButton1_Click()
Dim file As String
Dim myPath As String
Dim wb As Workbook
Dim rng As Range
Dim lastrow As Long, lastcolumn As Long
Dim wbMaster As Workbook
Set wbMaster = Workbooks("WorkTracker_Master.xlsm")
Set rng = wbMaster.Sheets("WorkTracker").Range("A4:W4")
myPath = "\\BMGSMP1012\GBDMC_Team$\GBDM_ContentManagement\+CM_Reports\Productivity Reports\FY18\"
file = Dir(myPath & "*.xls*")
While (file <> "")
Set wb = Workbooks.Open(myPath & file)
lastrow = wb.Worksheets("WorkTracker").Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = wb.Worksheets("WorkTracker").Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cell(2, 1)(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close
erow = WorkTracker.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination = Worksheets("WorkTracker").Range(Cells(erow, 1), Cells(erow, 4))
wb.Close SaveChanges:=True
Set wb = Nothing
file = Dir
Wend
Application.CutCopyMode = False
End Sub
You need to fully qualify all your objects, a comfortable and easy way, is to seperate each Workbook by using a nested With statement.
Also, as #YowE3K already mentioned in the comments above, you have a syntax error when defining the copied Range.
Try the code below, inside your While (file <> "") loop, after you Set wb = Workbooks.Open(myPath & file) :
With wb.Worksheets("WorkTracker")
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
lastcolumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 1), .Cells(lastrow, lastcolumn)).Copy
End With
With wbMaster.Worksheets("WorkTracker")
' get first empty row in column "A"
erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
' paste in the first empty row
.Range("A" & erow).PasteSpecial
End With
wb.Close SaveChanges:=True
Set wb = Nothing
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
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
I am trying to copy-paste special values and formatting from multiple workbooks into a master spreadsheet. The number of columns is the same in the source and destination and the number of rows varies.
I read the other threads on this and tried multiple ways (including defining a range in the destination file) but I still cannot make the paste special work. Below is my code:
Sub mergefiles()
Dim folderpath As String
Dim filepath As String
Dim filename As String
Dim erow As Long
folderpath = "D:\Test\"
filepath = folderpath & "*.xls*"
filename = Dir(filepath)
Dim lastrow As Long, lastcolumn As Long
Do While filename <> ""
Workbooks.Open (folderpath & filename)
Worksheets("EmplOffers").ShowAllData
lastrow = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(6, Columns.Count).End(xlToLeft).Column
Range(Cells(6, 3), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close
erow = Worksheets("EmplOffers").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
Worksheets("EmplOffers").Range(Cells(erow, 3), Cells(erow, 20)).PasteSpecial=:xlPasteValuesAndNumberFormats
filename = Dir
Loop
Application.DisplayAlerts = True
End Sub
Thanks a lot!
Try adjusting the paste call:
Worksheets("EmplOffers").Range(Cells(erow, 3).Address).PasteSpecial Operation:=xlPasteValuesAndNumberFormats
A named parameter should precede :=
Change
Worksheets("EmplOffers").Range(Cells(erow, 3), Cells(erow, 20)).PasteSpecial=:xlPasteValuesAndNumberFormats
To:
Worksheets("EmplOffers").Range(Cells(erow, 3), Cells(erow, 20)).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
The code is working fine but copying data from the active sheet not Sheet3 of workbooks kindly if any one guide me i replaced active sheet with sheet3 but that doesn't work either.
Sub copyDataFromMultipleWorkbooksIntoMaster()
Dim FolderPath As String, Filepath As String, Filename As String
FolderPath = "D:\Copy Multiple Excel to One master\"
Filepath = FolderPath & "*.xls*"
Filename = Dir(Filepath)
Dim LastRow As Long, 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(5, 1), Cells(LastRow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 1))
Filename = Dir
Loop
Application.DisplayAlerts = True
End Sub
Public Function ModDate()
ModDate = Format(FileDateTime(ThisWorkbook.FullName), "m/d/yy h:n ampm")
End Function
Sub copyDataFromMultipleWorkbooksIntoMaster()
Dim FolderPath As String, Filepath As String, Filename As String
FolderPath = "D:\Copy Multiple Excel to One master\"
Filepath = FolderPath & "*.xls*"
Dim lastRow As Long, lastCol As Long, eRow As Long
Dim wb As Workbook, ws As Worksheet
Application.DisplayAlerts = False
Filename = Dir(Filepath)
Do While Filename <> ""
eRow = Sheet1.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row
Set wb = Workbooks.Open(FolderPath & Filename)
On Error Goto NextFile
Set ws = wb.Worksheets("Sheet3")
With ws
lastRow = .Cells(.Rows.count, 1).End(xlUp).Row
lastCol = .Cells(1, .Columns.count).End(xlToLeft).Column
.Range(.Cells(5, 1), .Cells(lastRow, lastCol)).Copy
Sheet1.Cells(eRow, 1).PasteSpecial xlPasteValues
End With
NextFile:
On Error Goto 0
wb.Close False
Filename = Dir
Loop
Application.DisplayAlerts = True
End Sub