Hi I have a code and it pops up a massage box with
run time error 1004
that it can't find the file that I want to open. How can I handle it? I got stuck in it already for hours and I can't find what was going wrong. I want to open an XLSX file that is saved in the same folder with the macro file and they are the only files in the folder, can someone help?
Private Sub cmdStartMonth_Click()
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
'Analyze month by selecting
Dim myPath As String
Dim FileName As String
Dim UnionWB As Workbook
Dim MonthName As String
MonthName = ListMonth.Value
myExtension = "*.xlsx*"
Dim sWrkbkPath As String
sWrkbkPath = Dir$(ThisWorkbook.Path & "\*.xlsx")
'Only expecting a single file so no need to loop.
If sWrkbkPath <> "" Then
Set UnionWB = Workbooks.Open(sWrkbkPath)
End If
UnionWB.Worksheets("Union").Range("A1:Y1").AutoFilter
With UnionWB.Worksheets("Union")
.Activate
.Range("L1:W1").Find(MonthName, , xlValues, xlWhole).Activate
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
that is the problematic row in the code:
Set UnionWB = Workbooks.Open(sWrkbkPath)
Change this
Set UnionWB = Workbooks.Open(sWrkbkPath)
to this
Set UnionWB = Workbooks.Open(Thisworkbook.Path & "\" & sWrkbkPath)
Related
I need to copy data from one sheet on my desktop, and paste it to every xlsx file in a specified folder. The problem I am encountering is an endless loop of copy paste / adding rows.
paste_value is the value to be pasted in the specified range in the specified sheet " Exhibit 1d"
Below is the code
Sub loopFile()
Dim Filename, Pathname As String
Dim wb As Workbook
Dim paste_value As String
paste_value = Workbooks("copy_file.xlsx").Worksheets("EXHIBIT 1D").Range("B59:C64").Copy
Pathname = "C:\Users\GP8535\Desktop\loop_folder\"
Filename = Dir(Pathname & "\*.xls*")
Do While Filename <> ""
Application.DisplayAlerts = False
Application.ScreenUpdating = False
paste_value = Workbooks("copy_file.xlsx").Worksheets("EXHIBIT 1D").Range("B59:C64").Copy
Set wb = Workbooks.Open(Pathname & Filename)
wb.Worksheets("EXHIBIT 1D").Rows("57:63").EntireRow.Insert
wb.Worksheets("EXHIBIT 1D").Range("B59:C63").PasteSpecial
wb.Close SaveChanges:=True
Loop
End Sub
Try this. A few issues
your syntax for defining paste_value was wrong; I think better to define the range (using Set) and do this outside the loop as it doesn't change
key thing to loop through your files is the last line in the loop; your code would have opened the same workbook each time
don't forget to turn alerts and updating back on at the end
Sub loopFile()
Dim Filename, Pathname As String
Dim wb As Workbook
Dim paste_value As Range
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Pathname = "C:\Users\GP8535\Desktop\loop_folder\"
Filename = Dir(Pathname & "\*.xls*")
Set paste_value = Workbooks("copy_file.xlsx").Worksheets("EXHIBIT 1D").Range("B59:C64")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
wb.Worksheets("EXHIBIT 1D").Rows("57:63").EntireRow.Insert
paste_value.Copy wb.Worksheets("EXHIBIT 1D").Range("B59:C63")
wb.Close SaveChanges:=True
Filename = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I am getting a 1004 error when I try and combine workbook pages into one master document. The code works correctly on my device, but when I attempt to run the code on my friends device it throw a 1004 error. I believe he is on excel 2013, I am on excel 2016. Is there any way to convert my code into something that can be used on both devices?
Sub CombineSheets()
Dim sPath As String
Dim sFname As String
Dim wBk As Workbook
Dim wSht As Variant
Application.EnableEvents = False
Application.ScreenUpdating = False
sPath = InputBox("Enter a full path to workbooks")
ChDir sPath
sFname = InputBox("Enter a filename pattern")
sFname = Dir(sPath & "\" & sFname & ".xl*", vbNormal)
wSht = InputBox("Enter a worksheet name to copy")
Do Until sFname = ""
Set wBk = Workbooks.Open(sFname)
Windows(sFname).Activate
Sheets(wSht).Copy Before:=ThisWorkbook.Sheets(1)
wBk.Close False
sFname = Dir()
Loop
ActiveWorkbook.Save
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
This works correctly when I run it, prompts for the folder location, asks which files it should copy from (usually *), and then copies from specifically the worksheet name entered.
Realistically all I need is code that can extract one worksheet from several hundred excel files and combine them into one master document. being able to pick and choose which worksheets would just be a bonus.
Thank you!
Like Mat's Mug said, you should really validate you inputs.
Did your co-worker add a "\" at the end of the path? Does the Path even exist?
Test to make sure that the sheet exists in the file that you are copying from, with something like this:
Function SheetExists(Name As String, Optional Workbook As Excel.Workbook = Nothing) As Boolean
If Workbook Is Nothing Then Set Workbook = ThisWorkbook.Application.ActiveWorkbook
On Error Resume Next
If Workbook.Worksheets(Name).Name <> vbNullString Then
End If
If Err.Number = 0 Then SheetExists = True
On Error GoTo 0
End Function
Here is your code with the noted changes:
Sub CombineSheets()
Dim sPath As String
Dim sFname As String
Dim wBk As Workbook
Dim sSht As String
Application.EnableEvents = False
Application.ScreenUpdating = False
sPath = InputBox("Enter a full path to workbooks")
'Use the FolderPicker to verify the path
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then sPath = .SelectedItems(1)
End With
'ChDir sPath
sFname = InputBox("Enter a filename pattern")
sFname = Dir(sPath & "\" & sFname & ".xl*", vbNormal)
sSht = InputBox("Enter a worksheet name to copy")
Do Until sFname = ""
Set wBk = Workbooks.Open(sFname)
'Windows(sFname).Activate
If SheetExists(sSht, wBk) Then
wBk.Sheets(sSht).Copy Before:=ThisWorkbook.Sheets(1)
End If
wBk.Close False
sFname = Dir()
Loop
'ActiveWorkbook.Save
ThisWorkbook.Save
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
The bigger question is, are the Sheets the same size? Old .xls files only have 65536 rows, where 2007+ .xlsx files go up to 1048576 rows.
You can't mix the two different worksheets. In that case, you need to copy all of the cells from one sheet to the other.
wBk.Sheets(sSht).Cells.Copy
ThisWorkbook.Sheets.Add Before:=ThisWorkbook.Sheets(1)
ThisWorkbook.Sheets(1).Paste
I have written the below code to loop through all the files in a directory and copy certain values from them and paste it back into the master file.
The problem that I am having is that the code never fully runs through all the files and I never get an error.
As shown in the picture the file names are depicted as 1 - #####, then 2 - ####, etc.
Sometimes there are multiple of the first number like in the picture there are two 1 - ###'s but the end numbers are still different.
The problem is that instead of going by the actual numerical order the code is using only the first number and going from 1, 10, 11, 100 and completely skipping the rest.
Any ideas on how to solve this?
Sub ReadDataFromCloseFile()
On Error GoTo ErrHandler
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim FileType As String
Dim FilePath As String
FileType = "*.xlsm*" 'The file type to search for
FilePath = "\\filepath\" 'The folder to search
Dim src As Workbook
Dim OutputCol As Variant
Dim Curr_File As Variant
OutputCol = 9 'The first row of the active sheet to start writing to
Curr_File = Dir(FilePath & FileType)
Do Until Curr_File = ""
' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE".
Set src = Workbooks.Open(FilePath & Curr_File, True, True)
Sheets("Reporting").Range("I7:I750").Copy
Workbooks("Master.xlsm").Activate
Sheets("Sheet2").Select
Sheets("Sheet2").Cells(4, OutputCol).Select
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
OutputCol = OutputCol + 1
' CLOSE THE SOURCE FILE.
src.Close False ' FALSE - DON'T SAVE THE SOURCE FILE.
Curr_File = Dir
Loop
Set src = Nothing
Application.EnableEvents = True
Application.ScreenUpdating = True
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Filepath
I've no idea why it doesn't open the 2 to 9 files. This version puts all the file paths into a collection and then steps through the collection.
It also does away with selecting the sheets before pasting, etc.
Sub ReadDataFromCloseFile()
Dim FileType As String
Dim FilePath As String
Dim colFiles As Collection
Dim src As Workbook
Dim tgt As Workbook
Dim OutputCol As Variant
Dim Curr_File As Variant
Set colFiles = New Collection
FileType = "*.xlsm*" 'The file type to search for
FilePath = "\\filepath\" 'The folder to search
EnumerateFiles FilePath, FileType, colFiles
OutputCol = 9 'The first row of the active sheet to start writing to
'If Master.xlsm is the book containing this code then use '=ThisWorkbook'
Set tgt = Workbooks("Master.xlsm")
For Each Curr_File In colFiles
Set src = Workbooks.Open(Curr_File, True, True)
src.Worksheets("Reporting").Range("I7:I750").Copy
tgt.Worksheets("Sheet2").Cells(4, OutputCol).PasteSpecial xlPasteValuesAndNumberFormats
OutputCol = OutputCol + 1
src.Close False
Next Curr_File
End Sub
Sub EnumerateFiles(ByVal sDirectory As String, _
ByVal sFileSpec As String, _
ByRef cCollection As Collection)
Dim sTemp As String
sTemp = Dir$(sDirectory & sFileSpec)
Do While Len(sTemp) > 0
cCollection.Add sDirectory & sTemp
sTemp = Dir$
Loop
End Sub
It might be easier for you to loop through the files using the below loop.
Sub LoopFiles()
Dim FSO As New FileSystemObject
Dim Fldr As Folder
Dim Fl As File
'Loop through files in folder
For Each Fl In FSO.GetFolder(filePath).Files
'Check for file type
If Fl.Type = "Excel Macro-Enabled Workbook" Then
'Open file & do procedure
End If
Next
Set FSO = Nothing
End Sub
Try declaring your variable OutputCol as an integer and not a variant. If you know your data is always going to be a number, it's never a good idea to use a variant. It takes more resources to execute the code and you don't know all of the internal logic that is going on behind the scenes. It also gives you more control of the code's execution and probably won't give you headaches like this one. Only use a variant if you don't know what data you are going to output.
Hope this helps!
I am a novice at VBA. I am using Excel 2013 for this task. I have several Excel files I am combining into a single file with multiple sheets using the macro below.
Sub Merge2MultiSheets()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "H:\Survey Research\ECAS\Reports\2015\Tracks"
Set wbDst = Workbooks.Add(xlWBATWorksheet)
strFilename = Dir(MyPath & "\*.xls", vbNormal)
If Len(strFilename) = 0 Then Exit Sub
Do Until strFilename = ""
Set wbSrc = Workbooks.Open(FileName:=MyPath & "\" & strFilename)
Set wsSrc = wbSrc.Worksheets(1)
wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
wbSrc.Close False
strFilename = Dir()
Loop
wbDst.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I want each sheet in the new file to take the name of its original file. I tried to edit the code below and include in the macro above, but while I didn't get an error message, it did not accomplish the task.
Do While fileName <> ""
Workbooks.Open (directory & fileName)
WrdArray() = Split(fileName, ".")
For Each sheet In Workbooks(fileName).Worksheets
Workbooks(fileName).ActiveSheet.Name = WrdArray(0)
total = Workbooks("import-sheets.xlsm").Worksheets.Count
Workbooks(fileName).Worksheets(sheet.Name).Copy after:=Workbooks("import- sheets.xlsm").Worksheets(total)
Once the files have been merged and the sheets named, I want to output the new file and to easily update it if the data in my original files change.
Is it possible to achieve all of this with one macro? If so, could anyone suggest a way to write a Macro in Excel to automatically name the sheets, output the file and update it if changes are made to the data in the original files?
For the first part I think you only need to add one line:
Do Until strFilename = ""
Set wbSrc = Workbooks.Open(FileName:=MyPath & "\" & strFilename)
Set wsSrc = wbSrc.Worksheets(1)
'name the tab according to the file name
wsSrc.Name = Replace(strFilename,".xls","")
wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
wbSrc.Close False
strFilename = Dir()
Loop
The last part about updating the workbook if the source files change is potentially much more complex: the easiest approach would be to re-run the consolidation code. If that doesn't work for you then you'd need to add more details on that.
I have 30 xlsx files in a folder and I want the first sheet of all that files to be merged to a new workbook. The thing is I don't want the macro to copy paste the value in to the same sheet of the new master sheet like Ron's excel merge tool does. I want a macro to create new 30 sheets on the master file and copy the data from source files. And I want the newly added sheets to be renamed as the source file name. I searched the forums for hours and found the below code. This works well except the sheet renaming thing. Can someone please look into the code and please help me to add sheet rename part to the code?
Sub Merge2MultiSheets()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFileName As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "C:\Jude" ' change to suit
Set wbDst = Workbooks.Add(xlWBATWorksheet)
strFileName = Dir(MyPath & "\*.xlsx", vbNormal)
If Len(strFileName) = 0 Then Exit Sub
Do Until strFileName = ""
Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFileName)
Set wsSrc = wbSrc.Worksheets(1)
wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
wbSrc.Close False
strFileName = Dir()
Loop
wbDst.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
wbDst.Worksheets(wbDst.Worksheets.Count).Name = strFileName
If you want to include the path then you'll need to remove the backslash '\' and any other invalid sheet-name characters.
Make sure the name does not contain any of the following characters: :
\ / ? * [ or ]