Copy range from sheet, and loop through files in a directory and do the following, Add rows to specific sheet, and paste values into sheet - vba

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

Related

Merge multiple Excel files into a new Excel file

I know the question has been asked so many times already, and I have tried to use Google to search the interest but failed to find the correct code. ( Trust me, I am not a taker).
Anyway, the idea is to run a script to merge all Excel files (CAD,GBP,JPY,USD) into a new Excel file (tab shows name "CAD","GBP", "JPY","USD") in the current folder. I have written the following script to merge Excel files, but it does not even work.
Sub CombineWorkbooks()
Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "X:\PATH\TO\EXCEL\FILES"
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
You only have one small mistake.
Change:
Wkb.Close False
To:
Wkb.Close SaveChanges:=False
Here's my full, tested and working solution:
Sub CombineWorkbooks()
Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "X:\PATH\TO\EXCEL\FILES"
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close SaveChanges:=False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
If this doesn't work for you, please give more detail about the results and/or errors. A list of the file names in the folder would also be helpful.
If this does work for you, please remember to mark this as your answer, so others will know you have your solution. Thanks!

Copy a specific worksheet from multiple workbooks without openeing the workbook

I have a code below which copies a specific worksheets form all active or open workbooks.
But how to copy the same Worksheet without opening the workbooks, like if we can provide the path in the code , it should be able to pick the given worksheet from all the workbooks form that path.
Below is the code that am currently using.
Sub CopySheets1()
Dim wkb As Workbook
Dim sWksName As String
sWksName = "SHEET NAME"
For Each wkb In Workbooks
If wkb.Name <> ThisWorkbook.Name Then
wkb.Worksheets(sWksName).Copy _
Before:=ThisWorkbook.Sheets(1)
End If
Next
Set wkb = Nothing
End Sub
Work with Workbooks.Open Method to open it in in the background, and hide any alerts with Application / ScreenUpdating / EnableEvents / DisplayAlerts
Application.ScreenUpdating Property (Excel) Turn screen updating off to speed up your macro code. You won't be able to see what the macro is doing, but it will run faster.
Example
Sub CopySheets1()
Dim wkb As Workbook
Dim sWksName As String
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
wkb Workbooks.Open("C:\temp\bookname.xls")
sWksName = "SHEET NAME"
For Each wkb In Workbooks
wkb.Worksheets(sWksName).Copy _
Before:=ThisWorkbook.Sheets(1)
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
Set wkb = Nothing
End Sub
Assuming your folder name is C:\Temp\ then Loop until folder returns an empty
Example
Dim FileName As String
' Modify this folder path as needed
FolderPath = "C:\Temp\"
' Call Dir the first time to all Excel files in path.
FileName = Dir(FolderPath & "*.xl*")
' Loop until Dir returns an empty .
Do While FileName <> ""
' Open a workbook in the folder
Set wkb = Workbooks.Open(FolderPath & FileName)
'--->> Do your copy here
' Close the source workbook without saving changes.
wkb.Close savechanges:=False
' next file name.
FileName = Dir()
Loop
Use a Do...Loop structure when you want to repeat a set of statements an indefinite number of times, until a condition is satisfied. If you want to repeat the statements a set number of times, the For...Next Statement is usually a better choice.
I am assuming that you don't want to display the opened workbook to the user so the operation is not visible on screen.
If that's the case, you can use the following line before your code
Application.ScreenUpdating = False
'open the new/target excel workbook and put all the sheets in there
And following after:
Application.ScreenUpdating = True
It seems then that you have to manually open the workbooks. You can automate this process in VBA as follows;
Sub CopySheets1()
Dim wkb As Workbook
Dim dirPath As String ' Path to the directory with workbooks
dim wkbName as String
dirPath="C:\folder\"
sWksName = "SHEET NAME"
wkbName=Dir(dirPath & "*.xlsx")
For example:
dirPath = "C:\folder\"
So that the input to the Dir function be like "C:\folder*.xlsx"
Application.DisplayAlerts = False
do while wkbName <> ""
Set wkb=Application.Workbooks.Open(dirPath & wkbName)
wkb.Worksheets(sWksName).Copy _
Before:=ThisWorkbook.Sheets(1)
wk.Close False
wkbName = Dir
loop
Application.DisplayAlerts = True
End Sub

Merge Many excel files to one new file with different sheet

I am trying to merge many excel files (workbooks) from a folder.
My problem is that I want to move different sheets to the new excel file.
At the moment my code can only move one sheet at the time from these different files.
Example:
I have 3 excel files named
1.xlsx
2.xlsx
3.xlsx
all 3 files have 3 sheets in it and I want to take sheet1 from 1.xlsx and sheet1 and sheet2 from 2.xlsx and finally sheet3 from 3.xlsx and put in a new excel file.
My code at the moment can only takes one sheet (and same sheet number) from each file and put in the new file.
My code so fare:
Sub MergeMultiSheets()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim Path As String
Dim Filename As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
path = "C:\Users\*ChangeThis*\Desktop\merge"
Set wbDst = Workbooks.Add(xlWBATWorksheet)
Filename = Dir(path & "\*.xlsx", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = ""
Set wbSrc = Workbooks.Open(Filename:=path & "\" & Filename)
sheet = 1
Set wsSrc = wbSrc.Worksheets(sheet)
wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
wbSrc.Close False
Filename = Dir()
Loop
wbDst.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Many thank in advance
You need to loop through all the Sheets in the current Workbook found in your folder.
Try the code below:
Sub MergeMultiSheets()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim Path As String
Dim Filename As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "C:\Users\*ChangeThis*\Desktop\merge"
Set wbDst = Workbooks.Add(xlWBATWorksheet)
Filename = Dir(Path & "\*.xlsx", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = ""
Set wbSrc = Workbooks.Open(Filename:=Path & "\" & Filename)
Sheet = 1
' ****** you need to loop on all sheets per Excel workbook found in Folder ******
For Each wsSrc In wbSrc.Sheets
wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
Next wsSrc
wbSrc.Close False
Filename = Dir()
Loop
wbDst.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Create macro to output and update file after merging several excel files

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.

Merging workbooks into a master workbook with seperate sheet for each file

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 ]