Copy and Paste VALUES from multiple workbooks to a worksheet in another workbook / Paste Value within Loop - vba

The heavy lifting of this problem has already been solved here:
Copy and paste data from multiple workbooks to a worksheet in another Workbook
After adapting the code, I got everything to work perfectly in about 15 minutes. However, I then spent the past 3 hours scouring stackoverflow and the rest of the internet trying to figure out how to get it to paste VALUES ONLY instead of bringing over the formatting and formulas with it.
I've tried using .PasteSpecial xlPasteValues, but every time I try this I get an error that says "Compile Error: Expected: end of statement"
I've also tried using .PasteSpecial(xlPasteValues), I get an error that says "Run-time error '1004': Unable to get the PasteSpecial property of the Range class"
My concern is that neither of these methods will work since there wasn't even a .Paste function to begin with.
So when I tried to just add .Paste, it gives me a "Run-time error '438': Object doesn't support this property or method"
Here's the whole code, but I'm mainly just trying to figure out how to do exactly the same with except pasting VALUES ONLY. Thanks!
Sub ConsolidateAllOrdenes()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim lRow As Long
Dim ws2 As Worksheet
Dim y As Workbook
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Choose Target Folder Path"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.xlsm*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
Set y = Workbooks.Open("C:\Consolidado\Consolidado_2018-09-05a.xlsm")
Set ws2 = y.Sheets("Consolidado_Orden")
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Copy data on "Orden de Compras" sheet to "consolidado_orden" Sheet in other workbook
With wb.Sheets("Orden de Compras")
lRow = .Range("C" & Rows.Count).End(xlUp).Row
.Range("A5:M" & lRow).Copy ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End With
wb.Close SaveChanges:=False
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "I hope that worked!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Replace your copy/paste with this:
With wb.Sheets("Orden de Compras")
Range("A2:M" & Cells(Rows.Count, "A").End(xlUp).Row).Copy
ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With

Sorry, I'm new to this, but I think I finally figured it out. I believe the range with the copy was lacking a defined workbook and sheet.
Once I specified the workbook and sheet for the copy, there was no issue with putting the paste range on another line and adding .PasteSpecial Paste:=xlPasteValues.
I was also copying 2 lines from each workbook that didn't actually have anything, so I added If WorksheetFunction.CountA(wb.Sheets("Orden de Compras").Range("C5:C200")) <> 0 Then and later Else and End If to skip that workbook if it didn't have anything within the range C5:C200.
I also added Application.CutCopyMode = False because a message box kept popping up after each file.
Replace the copy/paste with this:
With wb.Sheets("Orden de Compras")
If WorksheetFunction.CountA(wb.Sheets("Orden de Compras").Range("C5:C200")) <> 0 Then
lRow = .Range("C" & Rows.Count).End(xlUp).Row
wb.Sheets("Orden de Compras").Range("A5:M" & lRow).Copy
ws2.Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Else
End If
End With
Thanks to everyone and especially #GMalc for the help!!!

Related

Trying to use Excel VBA to combine data together from multiple spreadsheets, but my loop keeps saving over previously saved data

I found a website that has a macro that lets you complete a looped action for all spreadsheets in a file folder. I've used this macro as the basis for my macro below: See Link Here
I've been able to use it successfully for a few other projects, but I'm running into some issues on my current project. I have a number of spreadsheets in a file folder that I'm attempting to open, copy the data, then paste into a master spreadsheet. The goal is to put all the data from the many spreadsheets, into one singular spreadsheet. The list of the many spreadsheets in the file folder is a dynamic list that will change over time. So I can't simply individually reference every spreadsheet, that's why I'm trying to use the looping strategy from the link above.
The problem I'm having is some of the pastes are getting pasted over previous spreadsheet's values. So instead of each spreadsheet getting pasted at the bottom of the previous's values, some are getting pasted in the middle and overwriting information that I need. I think my problem is that excel is getting confused as to which spreadsheet should be referenced when I gets into the row.count, copy/paste section of the code and the variables for i & j are getting assigned incorrectly. But I can't figure out how to fix this. I'm out of ideas, and thoroughly frustrated! Apologies if I'm screwing up something rather basic, but I'm rather new to VBA.
Sub CombineReports()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim i As Integer
Dim j As Integer
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
myPath = "I:\Pricing\mt access\Tier Reports\Final Reports\"
'Target Path with Ending Extention
myFile = Dir(myPath)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'Worksheet tasks
i = wb.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
wb.Worksheets(1).Range("A5", "N" & i).Copy
Workbooks.Open ("I:\Pricing\mt access\Tier Reports\Final Reports\Combined Report\CombinedTierReport.xlsx")
j = Workbooks("CombinedTierReport.xlsx").Worksheets("AllStores").Range("B" & Rows.Count).End(xlUp).Row
Workbooks("CombinedTierReport.xlsx").Worksheets("AllStores").Range("A" & j + 1, "N" & i).PasteSpecial xlPasteValues
Workbooks("CombinedTierReport.xlsx").Save
Workbooks("CombinedTierReport.xlsx").Close
DoEvents
'Save and Close Workbook
Application.DisplayAlerts = False
wb.Close SaveChanges:=False
Application.DisplayAlerts = True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Change Range("A" & j + 1, "N" & i) to Range("A" & j + 1). a) the range is wrong and b) you only need the top-left cell of a paste.
...
i = wb.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
wb.Worksheets(1).range("A5", "N" & i).Copy
with Workbooks.Open ("I:\Pricing\mt access\Tier Reports\Final Reports\Combined Report\CombinedTierReport.xlsx")
j = .Worksheets("AllStores").Range("B" & Rows.Count).End(xlUp).Row
.Worksheets("AllStores").Range("A" & j + 1).PasteSpecial xlPasteValues
.Save
.Close savechanges:=false
end with
...

Macro to loop through all worksheets except the first two and copy a cell and range into another workbook

I have a master workbook that I have that already looks through all the files in a folder. However, one of the tabs needs to look through all the tabs in a different selected workbook "Data". The workbook has roughly 30 worksheets, and I need to loop through each worksheet except "Investments" and "Funds". If it makes it easier these are the first two tabs in the workbook. I then need to copy cell F9 in each worksheet, paste it into a different workbook "Master" cell "C4", go back to the same worksheet in the "data" workbook and copy range "C16:C136" and paste that into cell "E4" of the "master" workbook. Then it would need to loop to the next worksheet in the "data" workbook and continue the loop. For each new worksheet, I need it to paste one row lower in the "master" file. i.e. the second worksheet would paste in "C5" and "E5".
If it makes it easier I can split this up into two macros. And Just paste all the data from the worksheets into a new blank sheet in the data work book and then I can have another one to copy all of that over into the "master" workbook once done.
Thanks in Advance
Sub ImportInformation()
WorksheetLoop
End Sub
Function WorksheetLoop()
Dim wb As Workbook
Dim ws As Worksheet
Dim foundCell As Range
Dim strFind As String
Dim fRow, fCol As Integer
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
' This allows you to use excel functions by typing wf.<function name>
Set wf = WorksheetFunction
'Set the name of your output file, I assume its fixed in the Master File
‘Please note that I am running this out of the master file and I want it all in the Noi tab
Set NOI = ThisWorkbook.Worksheets("NOI")
'Retrieve Target File Path From User
Set FilePicker = Application.FileDialog(msoFileDialogFolderPicker)
‘This only selects a folder, however I would like it to select a SPECIFIC FILE
With FilePicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
' initialize the starting cell for the output file
pasterow = 4
‘I need this to be referring to the file that I choose
For Each ws In wb.Worksheets
If ws.Name <> "Funds" And ws.Name <> "Investments" Then
Next ws
Wb.Worksheets.Range.("F9").Copy
NOI.Range("C" & pasterow).PasteSpecial xlPasteValues, Transpose:=False
'Get find String
strFind = NOI.Range("C2").Value
'Find string in Row 16 of each row of current ACTIVE worksheet
Set foundCell = wb.Worksheets.Range("A16:IT16").Find(strFind, LookIn:=xlValues)
'If match cell is found
If Not foundCell Is Nothing Then
'Get row and column
fRow = foundCell.Row
fCol = foundCell.Column
'Copy data from active data worksheet “data” and copy over 300 columns (15 years).
‘ This is needed to find what specific date to start at. This portion works, I just need it to loop through each worksheet.
wb.Worksheets.active.Range(Cells(fRow + 1, fCol).Address & ":" & Cells(fRow + 1, fCol + 299).Address).Copy
'Paste in NOI tab of mater portfolio
NOI.Range("E" & pasterow).PasteSpecial xlPasteValues, Transpose:=False
wb.Application.CutCopyMode = False
Else
Call MsgBox("Try Again!” vbExclamation, "Finding String")
End If
Next Ws
wb.Close SaveChanges:=False
End Function
Please show us your first attempt. Feel free to put in comments like
' I need this to do XXXX here, but I don't know how
Here are a some hints:
To loop through all sheets in a workbook, use:
For each aSheet in MyWorkbook.Sheets
To skip some specific sheets, say:
If aSheet.Name <> "Investments" And aSheet.Name <> "Funds"
To copy from aSheet to MasterSheet, start by setting the initial destinations:
set rSource = aSheet.range("F9")
set rDestin = MasterSheet.range("C4")
Then in your loop you do the copy:
rDestin.Value = rSource.Value
...and set up the next set of locations
set rSource = rSource.offset(1,0)
set rDestin = rDestin.offset(1,0)
Does that help?
EDIT: Briefly looking at your version, I think this part won't work:
If ws.Name <> "Funds" And ws.Name <> "Investments" Then
Next ws
Don't you want to delete that last line?
EDIT 2: You use this a lot:
wb.Worksheets.<something>
But that does not refer to a specific worksheet. You want to use "ws", like this:
ws.Range("F9")
BIG EDIT:
Step through this version carefully and see how it works:
Sub ImportInformation()
WorksheetLoop
End Sub
Function WorksheetLoop()
Dim wb As Workbook
Dim ws As Worksheet
Dim foundCell As Range
Dim strFind As String
Dim fRow, fCol As Integer
'*** Adding Dims:
Dim wf, FilePicker
Dim NOI As Worksheet
Dim myPath As String
Dim PasteRow As Long
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
' This allows you to use excel functions by typing wf.<function name>
Set wf = WorksheetFunction
'Set the name of your output file, I assume its fixed in the Master File
'Please note that I am running this out of the master file and I want it all in the Noi tab
Set NOI = ThisWorkbook.Worksheets("NOI")
'Retrieve Target File Path From User
' Set FilePicker = Application.FileDialog(msoFileDialogFolderPicker)
'This only selects a folder, however I would like it to select a SPECIFIC FILE
' With FilePicker
' .Title = "Select A Target Folder"
' .AllowMultiSelect = False
' If .Show <> -1 Then GoTo NextCode
' myPath = .SelectedItems(1) & "\"
' End With
Dim WorkbookName As Variant
' This runs the "Open" dialog box for user to choose a file
WorkbookName = Application.GetOpenFilename( _
FileFilter:="Excel Workbooks, *.xl*", Title:="Open Workbook")
Set wb = Workbooks.Open(WorkbookName)
' initialize the starting cell for the output file
PasteRow = 4
'I need this to be referring to the file that I choose
For Each ws In wb.Worksheets
If ws.Name <> "Funds" And ws.Name <> "Investments" Then
' **** Leave this out: Next ws
ws.Range("F9").Copy '<--- You mean this, not wb.Worksheets.Range.("F9").Copy
NOI.Range("C" & PasteRow).PasteSpecial xlPasteValues, Transpose:=False
'Get find String
strFind = NOI.Range("C2").Value
'Find string in Row 16 of each row of current ACTIVE worksheet
Set foundCell = ws.Range("A16:IT16").Find(strFind, LookIn:=xlValues)
'If match cell is found
If Not foundCell Is Nothing Then
'Get row and column
fRow = foundCell.Row
fCol = foundCell.Column
'Copy data from active data worksheet “data” and copy over 300 columns (15 years).
' This is needed to find what specific date to start at. This portion works, I just need it to loop through each worksheet.
ws.Range(Cells(fRow + 1, fCol).Address & ":" & Cells(fRow + 1, fCol + 299).Address).Copy
'Paste in NOI tab of mater portfolio
NOI.Range("E" & PasteRow).PasteSpecial xlPasteValues, Transpose:=False
'*** Move PasteRow down by one
PasteRow = PasteRow + 1
wb.Application.CutCopyMode = False
Else
Call MsgBox("Try Again!", vbExclamation, "Finding String")
End If
End If
Next ws
wb.Close SaveChanges:=False
End Function

Code to merge data in multiple documents by column

Is there a way to merge the data in multiple excel spreadsheets together by column?
I have 200 spreadsheets, each with text in the first 100 columns (A-CV).
I would like to merge all the "A" columns from these 200 documents together, all the "B" columns together, all the "C" columns together, and so on.
As for the merging, no particular order is required. As long as the cells themselves don't get merged.
Due to the large amount of text the code would be merging, it would be more practical to be able to merge one column at a time across all spreadsheets into a unique file, then repeat that with all other columns (A-CV), instead of attempting to merge all the columns (from all spreadsheets) together into one single file.
I found a code that merges columns, but it's not quite what I need. Is there a way to modify this code to help with what I described above?
Sub Macro1()
'
' Macro1 Macro
'
Dim cell As Range
For i = 1 To 50
Sheets("Sheet1").Select
If Cells(1, i).Value = "Cat 2" Then
Columns(i).Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
End If
If Cells(1, i).Value = "Cat 6" Then
Columns(i).Select
Selection.Copy
Sheets("Sheet2").Select
Range("B1").Select
ActiveSheet.Paste
End If
If Cells(1, i).Value = "Cat 4" Then
Columns(i).Select
Selection.Copy
Sheets("Sheet2").Select
Range("C1").Select
ActiveSheet.Paste
End If
Next i
End Sub
If you need more information, please let me know. And if I need to rename the documents a certain way to help with the process, I'm definitely willing to do that.
The merged data can be sent to a spreadsheet, word document, or notepad. I'm fine with any of these options.
UPDATE: This is the new code with modifications. The issues I am having are in the comment below.
Sub copydocument()
Dim wb As Workbook
Dim wb1 As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo resetsettings
Set wb = ThisWorkbook
MyPath = "C:\Users\HNR\Desktop\A\" 'Path of folder with \ at the end
MyExtension = "*.xlsx"
Myfile = Dir(MyPath & MyExtension)
While Myfile <> vbNullString
Set wb1 = Workbooks.Open(MyPath & Myfile)
lr = wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
lr1 = wb1.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
wb1.Sheets(1).Range("A" & lr1).Copy Destination:=wb.Sheets(1).Range("A" & (lr + 1))
wb1.Close
Myfile = Dir
Wend
resetsettings:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
While there are many ways to do what you want, I would recommend looking into Power Query. It gives you a great GUI to work with to accomplish this. Depending on your version of excel it is either a free add-on or part of the shipped product(for new versions of office).
You do not need to know how to code to use this, you just need to understand the concepts.
While its not exactly the answer you are after i have successfully taught several people at my work place how to use this application that would have previously been reliant on me or someone else with VBA skills.
Sub copydocument()
Dim wb As Workbook
Dim wb1 As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo resetsettings
Set wb = ThisWorkbook
MyPath = "c:\Users\foo\" 'Path of folder with \ at the end
MyExtension = "*.xlsx"
Myfile = Dir(MyPath & MyExtension)
While Myfile <> vbNullString
Set wb1 = Workbooks.Open(MyPath & Myfile)
lr = wb.Sheets(1).Range("A1:A" & Rows.Count).End(xlUp).Row
lr1 = wb1.Sheets(1).Range("A1:A" & Rows.Count).End(xlUp).Row
wb1.Sheets(1).Range("A1:CV" & lr1).Copy Destination:=wb.Sheets(1).Range("A" & (lr + 1))
wb1.close
Myfile = Dir
Wend
resetsettings:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
This macro will go through all the files in the folder and copy the sheet1 range and paste it in the active workbook sheet1. if you have headers and dont want them to repeat you can copy the header to the sheet1 of activeworkbook then copy range from (A2:CV &lr1).

Copying data from many workbooks to a summary workbook with Excel-VBA. Run time errors

I have files in a folder and I want to copy data from these files and paste them into another Master workbook sheet.
I keep getting a runtime error ‘1004’: Sorry we couldn’t find C:\Users\jjordan\Desktop\Test Dir\MASTER`, It is possible it was moved, renamed or deleted.
The error is highlighted on this line of code: Workbooks.Open SumPath & SumName
I have seen other questions similar to this on the web, I have tried making various changes. But still without success. Please advise.
Dir for source files: C:\Users\ jjordan \Desktop\Test Dir\GA Test\
Dir for Master file: C:\Users\ jjordan \Desktop\Test Dir\MASTER\
Source filenames differ, but all end in "*.xlsx."
Master filename: " MASTER – Data List - 2016.xlsm " ‘macro file
Source worksheet name = "Supplier_Comments"
Master worksheet name = "Sheet5"
Option Explicit
Sub GetDataFromMaster()
Dim MyPath As String
Dim SumPath As String
Dim MyName As String
Dim SumName As String
Dim MyTemplate As String
Dim SumTemplate As String
Dim myWS As Worksheet
Dim sumWS As Worksheet
'Define folders and filenames
MyPath = "C:\Users\jjordan\Desktop\Test Dir\GA Test\"
SumPath = "C:\Users\jjordan\Desktop\Test Dir\MASTER\"
MyTemplate = "*.xlsx" 'Set the template.
SumTemplate = "MASTER – Data List - 2016.xlsm"
'Open the template file and get the Worksheet to put the data into
SumName = Dir(SumPath & SumTemplate)
Workbooks.Open SumPath & SumName
Set sumWS = ActiveWorkbook.Worksheets("Sheet5")
'Open each source file, copying the data from each into the template file
MyName = Dir(MyPath & MyTemplate) 'Retrieve the first file
Do While MyName <> ""
'Open the source file and get the worksheet with the data we want.
Workbooks.Open MyPath & MyName
Set myWS = ActiveWorkbook.Worksheets("Suppliers_Comment")
'Copy the data from the source and paste at the end of sheet 5
myWS.Range("A2:N100").Copy
sumWS.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
'Close the current sourcefile and get the next
Workbooks(MyName).Close SaveChanges:=False 'close
MyName = Dir 'Get next file
Loop
'Now all sourcefiles are copied into the Template file. Close and save it
Workbooks(SumName).Close SaveChanges:=True
End Sub
Here is a template for what you'd like done. NOTE that forward slashes can cause run time error b/c vba handles them in an annoying way.
Sub DougsLoop()
Dim wbk As Workbook
Dim Filename As String
Dim path As String
Dim rCell As Range
Dim rRng As Range
Dim wsO As Worksheet
Dim StartTime As Double
Dim SecondsElapsed As Double
Dim sheet As Worksheet
Application.ScreenUpdating = False 'these three statements help performance by disabling the self titled in each, remeber to re-enable at end of code
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
StartTime = Timer 'Starts timer to see how long code takes to execute. I like having this in macors that loop through files
path = "C:\Users\jjordan\Desktop\Test Dir\GA Test" & "\" 'pay attention to this line of code********
Filename = Dir(path & "*.xl??")
Set wsO = ThisWorkbook.Sheets("Sheet5")
Do While Len(Filename) > 0 'this tells the code to stop when there are no more files in the destination folder
DoEvents
Set wbk = Workbooks.Open(path & Filename, True, True)
For Each sheet In ActiveWorkbook.Worksheets
Set rRng = sheet.Range("a2:n100")
For Each rCell In rRng.Cells
wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(1, 0).Value = rCell
Next rCell
Next
wbk.Close False
Filename = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
alter to this to your needs and you'll find it works perfectly :)
EDIT: Also in your code you make use of COPY & PASTE a lot. Try avoid doing this in the future. Try doing something:
ThisWorkbook.Sheets("Sheet1").Range("a1").Value = OtherWork.Sheets("Sheet1").Range("a1").Value
This is more efficient and wont bog down your code as much.
here is some offset logic
wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(1, 0).Value =
wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(0, 1).Value =
wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(0, 2).Value =
notice the Offset(x,y) value? Essentially x is down and y is right. this is of course referencing the original position. So to get a value to go in the same row but three columns over you would use "Offset(0,3)" etc etc
Ill let you alter your code to do this. :)
I guess actually trying to piece it together was a struggle? Here this version assumes the macro is in the master workbook(and that youre running it form the master). If you want to change go ahead, but this is as far as I go. At some point, you'll have to experiment on your own.

'Workbook.open' error - Closes the file right after opening it

I need to get data on one hundred Excel workbooks. I created a macro to loop through those files, get the data and close them. But right after my Workbooks.open(path) opens the file, it closes it and throws a 1004 error saying that the method 'open' failed.
I tried to open another of those one hundred files and every one of them throws the same error. I tried to open a normal file (not one of those one hundred), through the macro, it opens normally.
Copied a bunch of those to my C:\, all of them throw an error.
Recorded a macro to open the file. The file opens because I clicked File->Open File, but it throws an error if I run the macro to open it.
Obviously the problem lies in those files.
LINK to the file.
--> CODE:
Just a normal Workbook.open code (There is no full code, it's just it! And I get an error with the file linked)
Workbook.Open("C:\file.xlsx")
--> They Open normally by hand without any error or problem.
--> They have:
* Querytables
* Normal formulas
* They are kinda small
--> Observations and what I tried:
The paths are right (it opens the file and closes it right after, and error).
The files I'm trying to open have connection queries, but I deleted the connections on my test files. Same error.
Tried the CurruptLoad param, same error (I don't know if I used it right).
Tried UpdateLinks:=0, same error.
Tried to open it through new Excel.Application, nothing changed.
Tried on another PC, same thing.
Anyone had something like this?
What should I try?
What are you doing after the open ?
If you are trying to do something else, then maybe file has not opened completely and error is based on next line not happening.
Solution I found for this case (here in my work)
Application.DisplayAlerts = False
set wb = Workbooks.Open(objFile.path, ReadOnly:=True, CorruptLoad:=xlExtractData)
wb.close
Application.DisplayAlerts = True
Through the CorruptLoad:=xlExtractData, it clear every table, every connection, and anything else that could be problem. I get my data and close the file without saving it.
Thanks for the support guys.
If I understand your problem you can use one code that I use when I need to retrieve data from plus files (all with the same formatting )
Sub ImportData()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim LastRow As Long
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
WsTo = ActiveWorkbook.Name
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then Exit Sub
'Target File Extension (must include wildcard "*")
myExtension = "*.xlsx"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Change First Worksheet's Background Fill Blue
Sheets(1).Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
WsFrom = ActiveWorkbook.Name
Windows(WsTo).Activate
Sheets(1).Select
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Range("A" & LastRow + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, transpose:=False
Application.CutCopyMode = False
'Save and Close Workbook
Workbooks(WsFrom).Close SaveChanges:=False
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Importazione completata!"
'Reset Macro Optimization Settings
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub