I am new to vba, I want to transfer data from multiple sheets in one folder to one sheet. I wrote the programme as follows:
Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
MyFile = Dir("C:\Bulletinwork\")
Do While Len(MyFile) > 0
If MyFile = "Bmaster.xlsm" Then
Exit Sub
End If
Workbooks.Open (MyFile)
Range("A4:I42").Copy
ActiveWorkbook.Close
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 9))
MyFile = Dir
Loop
End Sub
Can someone help me find the reason why when I try to run the programme, I get an error message saying "sub or function not defined".
Kenny
The following line will be causing some grief:
Workbooks.Open (MyFile)
The () means that VBA is trying to evaluate MyFile before running the Open command. Of course, MyFile is a string/path so can't run.
Try
Workbooks.Open MyFile
instead.
Related
The code listed below is working for me to combine multiple workbook sheet1 (specific cell range) to the master sheet . But i'm facing one issue that is the paste special option is not working
For eg: My cells contains background color indication like amber, green and font color in each cells are different .I'm getting the output as plain text instead of rich text. If I try to modify the code with Pastespecial it's not working .
Can someone help me to fix this ?
Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Filepath = "Paste your path
MyFile = Dir(Filepath)
Do While Len(MyFile) > 0
If MyFile = "zmaster.xlsm" Then
End If
Workbooks.Open (Filepath & MyFile)
Range("A2:G2").Copy
ActiveWorkbook.Close
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 7))
MyFile = Dir
Loop
End Sub
I'm new to the site and in need of some help. I've created a Macro within excel to pull the values from certain cells in workbooks within a folder and consolidate that information. The code seems to be working, Except that it's only pulling from about half of the workbooks in the folder. Does anyone know Why it's doing this and how I can fix it?
Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Filepath = "T:\Sales Orders\2017\May\"
MyFile = Dir("T:\Sales Orders\2017\May\")
Do While Len(MyFile) > 0
If MyFile = "maytt.xlsm" Then
Exit Sub
End If
Workbooks.Open ("T:\Sales Orders\2017\May\" & MyFile)
Range("F1:F7").Copy
ActiveWorkbook.Close
ecolumn = Sheet1.Cells(Columns.Count).End(xlToLeft).Offset(0, 1).Column
ActiveSheet.Paste Destination:=Worksheets("Summary").Range(Cells(1, ecolumn), Cells(7, ecolumn))
MyFile = Dir
Loop
End Sub
It looks like you want to skip the file "maytt.xlsm" but what you are actually doing is stopping the whole thing (Then Exit Sub) when that file is reached. To skip the file and continue, do the following modifications to the code:
1- Add a line label before the myFile = Dir statement:
NextFile: ' <---------Add this
MyFile = Dir
Loop
2- Replace Exit Sub with Goto NextFile.
I created a macro in VBA (excel) to open a specific range of a daily file which all have a similar start of the name (9489) followed by a file specific date (DD-MM-YY). The selection is then copied into the masterfile (Masterfile.xlsm), this sub is run for all the files from the directory.
Since today however I keep getting an error named "Run-time error 1004: 9489 150116 Daily Dashboard.xlsx could not be found. Check the spelling of the file name, and verify that the file location is correct."
Why do I get this error? Most importantly, can anybody help me solve this error? I did not change the spelling of the file or the files location!
The code:
Sub LoopThroughDirectory()
Dim Myfile As String
Dim erow
Myfile = Dir("F:\WGD\Dep 408101-Se-DCIFINK-009786\Consolidatie & Regulatory Reporting\Regulatory Reporting\Daily dashboard of Ratios\Test Daily Dashboard\")
Application.DisplayAlerts = False
Do While Len(Myfile) > 0
If Myfile = "Masterfile.xlsm" Then
Exit Sub
End If
Workbooks.Open (Myfile)
Worksheets("Liquidity Reporting").Range("A2:E19").Copy
Windows("Masterfile.xlsm").Activate
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 5))
Workbooks(Myfile).Application.CutCopyMode = False
Workbooks(Myfile).Close SaveChanges:=False
Myfile = Dir
Loop
End Sub
The reason that Excel cannot find the file is that MyFile is just the filename; you need to also include that file path.
This line: ActiveSheet.Paste Destination... will throw an error.
Try to avoid select and activate.
There is no need to size a range when using copy and paste. You just need to target the top left cell of the destination range.
Sub LoopThroughDirectory()
Const FOLDERPATH = "F:\WGD\Dep 408101-Se-DCIFINK-009786\Consolidatie & Regulatory Reporting\Regulatory Reporting\Daily dashboard of Ratios\Test Daily Dashboard\"
Dim Myfile As String
Dim Source As Range, Target As Range
Myfile = Dir(FOLDERPATH)
Application.DisplayAlerts = False
Do While Len(Myfile) > 0
If Myfile <> "Masterfile.xlsm" Then
With Worksheets("Sheet1")
Set Target = .Range("A" & .Rows.Count).End(xlUp).Offset(1)
End With
With Workbooks.Open(FOLDERPATH & Myfile)
Set Source = .Worksheets("Liquidity Reporting").Range("A2:E19")
Source.Copy Destination:=Target
.Close SaveChanges:=False
End With
End If
Myfile = Dir
Loop
End Sub
I was attempting to extract data from other workbooks into a master workbook. All of these workbooks were saved in one folder. Besides, before extracting the data it would check the number of files in the folder. If there is only one file and it is the master workbook then it will stop and exit sub.
However, when I ran the macro it got stuck in the "Do while" loop. Then it says it has a run time error 1004, document may be read-only or encrypted1.
I am sure the path is correct.
Below is my code.
Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Filepath = "C:\Users\uidq3022\Desktop\Backup_Version2.0_7_12\"
MyFile = Dir(Filepath)
Do While Len(MyFile) > 0
If MyFile = "Import Info.xlsm" Then
Exit Sub
End If
Workbooks.Open (Filepath & MyFile)
Range("F9,F12,F15,F19,F21").Select
Range("F21").Activate
ActiveWindow.SmallScroll Down:=9
Range("F9,F12,F15,F19,F21,F27,F30,F33,F37").Select
Range("F37").Activate
ActiveWindow.SmallScroll Down:=9
Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41").Select
Range("F41").Activate
ActiveWindow.SmallScroll Down:=-27
Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41,F6").Select
Range("F6").Activate
Selection.Copy
ActiveWorkbook.Close
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 11))
MyFile = Dir
Loop
End Sub
And my questions are,
I don't know where I went wrong with the "Do while" loop
How to fix the run time 1004 error.
Can someone give me advise? Thanks a lot!
Seems to me you're using the loop to open the files instead of doing it manually yourself. Not sure why the loop got stuck unless you had the MyFile = Dir line missing or commented out at runtime.
#Thomas is mostly right, the 1004 error is happening because the source workbook is being closed too early. However, I was able to paste the values using wkbTarget.worksheets(1).paste but it pasted all cells between F6 through F41 - not what you want.
Additionally, your copy range is 11 rows, 1 column but you're specifying a destination range of 1 row, 11 columns: Cells(erow, 1), Cells(erow, 11) . If that's what you really want, you should use Transpose. Using Cells(#,#) inside Range() also produced 1004 errors, but Cells(#,#).address resolved it.
Here's my take:
Sub LoopThroughDirectory()
Dim MyFile As String
Dim wkbSource as Workbook
Dim wkbTarget as Workbook
Dim erow as single
Dim Filepath As String
Filepath = "C:\Users\uidq3022\Desktop\Backup_Version2.0_7_12\"
MyFile = Dir(Filepath)
Set wkbTarget = Workbooks(MyFile) 'Assuming the file is already open
Do While Len(MyFile) > 0
If MyFile = "Import Info.xlsm" Then Goto NextFile 'Skip the file instead of exit the Sub
Set wkbSource = Workbooks.Open (Filepath & MyFile) 'Set a reference to the file being opened
wkbSource.worksheet(1).Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41,F6").Select
Selection.Copy
erow = wkbTarget.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
wkbTarget.Worksheets("Sheet1").Paste Destination:=wkbTarget.Worksheets("Sheet1").Range(Cells(erow, 1).address)
wkbSource.Close
NextFile:
MyFile = Dir
Loop
End Sub
Thomas's single-line copy+paste technique is nicely concise. You could rearrange the lines of code to use that approach, I just recommend making the Source and Target objects clear.
Sub LoopThroughDecTab()
Dim MyFile As String
Dim erow
Dim FilePath As String
FilePath = "C:"
MyFile = Dir(FilePath)
Do While Len(MyFile) > 0
If MyFile = "Dec Tab Macro.xlsm" Then
Exit Sub
End If
Workbooks.Open (FilePath & MyFile)
ActiveWorkbook.Worksheets("Declaration Analysis (Source)").Activate
Range("H9:H21").Copy
ActiveWorkbook.Close False
'Getting Runtime error PasteSpecialMethod of Range Failed on following line'
ActiveSheet.Range(Cells(erow, 1), Cells(erow, 7)).PasteSpecial.Range Transpose:=True
MyFile = Dir
Loop
End Sub
I have files in a folder, the code loops through the files copies values and then I want those values Transposed into the Active MasterSheet. There are 7 values that need to be pasted, and then it should open the next workbook in folder and repeat the process.
Assuming that you posted your complete code, and simply interjected the 'non-code' message to tell us where your error was, give this a try:
Option Explicit
Sub LoopThroughDecTab()
Dim MyFile As String
Dim erow
Dim FilePath As String
Dim DestWB as Workbook
Dim SourceWB as Workbook
'this way we know the one where the code is running and the destination for our copies
set DestWB = ThisWorkbook
FilePath = "C:"
MyFile = Dir(FilePath)
Do While Len(MyFile) > 0
If MyFile = "Dec Tab Macro.xlsm" Then
Exit Sub
End If
Set SourceWB = Workbooks.Open (FilePath & MyFile)
SourceWB.Worksheets("Declaration Analysis (Source)").Range("H9:H21").Copy
'Move the close to AFTER you do the paste
'NOTE: You may have to make a change here:
DestWB.Range(Cells(erow, 1), Cells(erow, 7)).PasteSpecial.Range Transpose:=True
SourceWB.Close False
MyFile = Dir
Loop
End Sub
If you open two workbooks (A & B) in Excel, copy some cells from A, close A, then try to paste into B, you'll have nothing left to paste - closing A clears the clipboard buffer. I believe the same thing is happening here.
Important Notes:
I've removed all references to ActiveWorkbook - I believe that I've gotten it correct, but I always get a bit lost when using Active*, so I avoid it at all cost. (There are a very few situations where it's the only way to get things done, this isn't one of them.) If I've messed up your source & destinations for the copy, simply reverse the Set statements so you're using them the other way.
I'm not sure where erow and FilePath are getting set, so I'm assuming this wasn't the complete code. The assumption is that they'll still get set somehow.
I've not used the copy/transpose function, so you may well need to include Excel Developers's adjustments, as well.
It's difficult to understand what's the problem without seeing what are you copying, but you can try:
ActiveSheet.Cells(erow, 1).PasteSpecial Transpose:=True
set CopyFromRange = Range("H9:H21")
set CopyToRange = ActiveSheet.Cells(erow,1).Resize(1,13)
CopyToRange.Value = Application.Transpose(CopyFromRange.Value)