Looping through opened workbooks - excel

i have managed to get a code which opens all files existing in a folder. now i want to run a macro(Called as donemovementReport) on these files one by one like as it runs on
one i save the file then run on the next one.
The Macro donemovementreport pastes all data from these open sheets to a template. i want to save this tamplate not the opened workbook which carries the actual data.
anybody with some idea?
Sub OpenAllWorkbooks()
Set destWB = ActiveWorkbook
Dim DestCell As Range
FileNames = Application.GetOpenFilename( _
filefilter:="Excel Files (*.csv*),*.csv*", _
Title:="Select the workbooks to load.", MultiSelect:=True)
If IsArray(FileNames) = False Then
If FileNames = False Then
Exit Sub
End If
End If
For n = LBound(FileNames) To UBound(FileNames)
Set wb = Workbooks.Open(fileName:=FileNames(n), ReadOnly:=True)
Next n
'Dim i As Integer
'i = ActiveWorkbook.AcceptAllChanges
'For i = 1 To ActiveWorkbook
Call donemovementReport
'Next i
End Sub

If I understand the input correctly, you need to loop through ALL opened workbooks. This may be achieved using Workbooks collection. Use this piece of code for that:
Dim wb As Workbook
For Each wb In Workbooks
wb.AcceptAllChanges
Call donemovementReport
Next wb
Modify the code between For...Next as you wish or provide more input.
Read more about referencing to workbooks in VBA: http://www.techrepublic.com/blog/10things/10-ways-to-reference-excel-workbooks-and-sheets-using-vba/967 (the above code is item 3 of 10 listed there).

Related

Combine multiple workbooks each with one sheet into one workbook with multiple sheets

I have multiple CSV files, each with one worksheet.
The workbooks are saved under a specific name.
All the workbooks have the same format.
I have a separate workbook called RDI raw data.xlsm
I would like to copy all data from the workbooks into the RDI raw data file.
Each workbook needs to be a separate sheet in the RDI raw data file.
Place csv files in a folder called Import locally one sub folder of where you saved your master RDI file. The macro will copies the first sheet in the csv file and place after the first sheet in your master.
Sub cmdImportCSV()
'import multiple sheets in data folder'
Dim wb As Workbook
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim myPath As String
Dim strFilename As String
Dim ws As Worksheet
'skip screen updating and alerts'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'set path to the folder that contains the worksheets to Import folder'
myPath = ThisWorkbook.Path & "\Import\"
'set import destination to current workbook'
Set wb = ThisWorkbook
'the first file in the source folder'
strFilename = Dir(myPath)
'Speed up importing by not recalculating during loop'
Application.Calculation = xlCalculationManual
'start a loop - import all files in directory'
Do Until strFilename = ""
'set workbook source'
Set wbSource = Workbooks.Open(Filename:=myPath & "\" & strFilename)
'set the worksheet source to copy from'
Set wsSource = wbSource.Worksheets(1)
'set where the copy is going to'
wsSource.Copy after:=wb.Worksheets(1)
'close the current source workbook'
wbSource.Close
'returns the next source workbook'
strFilename = Dir()
Loop
'Reactivate Automatic calculations'
Application.Calculation = xlCalculationAutomatic
'Reactivate - show screen updated and if errors'
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
If you want to learn VBA, there are several ways you can achieve your goal, and get an education too. If you want a slick alternative which requires no coding, and achieves the same result, consider using this Excel AddIn.
https://www.rondebruin.nl/win/addins/rdbmerge.htm
It will do what you want, and it will do a whole bunch of other things as well, all with no coding, whatsoever!!

How to import or copy worksheets from different workbook in one workbook?

I just started learning VBA so please advise.
I have one Macro(master workbook) where I would like to import/copy worksheets from 5 different workbook.
So each of these 5 workbook contain different sheets out of which i would like to import/copy only one or particular sheets. These imported sheets should be marked as "Sheet 1(for data from workbook 1), Sheet 2(for data from workbook 2) and similarly in master workbook.
I have all of this Workbooks in one folder. This folder changes every week so i cannot give folder path. Rather i want the flexibility to Browse folder.
Thanks in advance for your help.
Example code of how to import all the sheets from an external workbook with browser:
Sub shCopy()
Dim fName As String, wb As Workbook
fName = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*")
Set wb = Workbooks.Open(fName)
For Each sh In wb.Sheets
sh.Copy Before:=ThisWorkbook.Sheets(1)
Next
wb.Close False
End Sub
Now you just need to specify the conditions on what sheet to actually copy, and name it accordingly.
Pretty sure we shouldn't be adding questions as answers. Next time you should probably make a new question.
But I can't see much deviation between the loops, and you are on the right track. But you don't actually need the If since everything within the loop will repeat each loop anyway.
The number for the file dialouge can be inserted with the i variable using the & operator.
Sub shCopy()
Dim fName As String, wb As Workbook, i As Integer
For i = 1 To 3
MsgBox "Select file " & i
fName = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*")
Set wb = Workbooks.Open(fName)
Sheets("Sheet1").Copy After:=Workbooks("mymacro.xlsm").Sheets(Workbooks("mymacro.xlsm").Sheets.Count)
ActiveSheet.Name = "Sheet" & Sheets.Count
wb.Close False
Next i
End Sub

VBA: copy range of data across workbooks and "save as" function in loop

I want to copy a range of cells in my .csv file into a template.csv (named "pp"). Then I would like to save the template as "name of the original .csv file_2", without closing the original template as I would need it to do this procedure in loop for all the files in my folder. I have come up with this code that doesn't work:
Sub LoopThroughDirectory()
Dim MyFile As String
Dim pp As Workbook ' Workbook to receive the copied data
Dim ppSht As Worksheet ' Worksheet where copied data will be inserted
Dim Wkb As Workbook ' Temporary workbook for the Loop
Dim Sht As Worksheet ' Temporary worksheet variable for the loop
MyFile = Dir("R:\COMT study\Silvia\Cognitive data\COMT 1\Tasks\CPT*.csv*")
Set pp = Workbooks("pp.csv")
Set ppSht = pp.Sheets("Sheet1")
Do While MyFile <> ""
Set Wkb = Workbook.Open("R:\COMT study\Silvia\Cognitive data\COMT 1\Tasks\CPT" & MyFile)
Set Sht = Wkb.Worksheets("sheet1")
Sht.Range("A1:G113").Copy
With ppSht
.Range("A1:G113").PasteSpecial xlPasteFormulas
End With
pp.SaveCopyAs Filename = MyFile_2.csv
Wkb.Close True
MyFile = Dir
Loop
End Sub
I am new to the vba coding and I am not sure what I am doing wrong as I don't get any error messages, the code simply doesn't run. Do you have any suggestion?
First of all I would like to recommend you how to use a CSV file (Comma-separated values). By this a csv file does not have any sheets. Therefore you can reach the worksheet with the following, there wb is the workbook. Another good advice is to use Option Explicit that enables some error codes, example if you get to initialize a variable.
Dim pp As Workbook
pp.Worksheets (1)
Do While MyFile <> ""
Set wb = Workbooks.Open("R:\COMT study\Silvia\Cognitive data\COMT 1\Tasks\CPT" & MyFile)
With wb.Worksheets(1)
Range(A1,G113).copy
End With
With ppSht
.Range(A1,G113).PasteSpecial xlPasteFormulas
End With
pp.SaveCopyAs Filename = "MyFile_2.csv"
'Remove the wb.Close if you want the sheet to stay open (Not recommended if there are many files)
wb.Close
MyFile = Dir
loop
Try using some of this (Haven't tried it so just use it as a template). See if you can get any errors or at least if you can collect the data from the file into a array.

How to extract data from multiple closed excel workbooks for placing in a separate workbook in different worksheets through VBA?

(Beginner VBA coder here!)
Does anyone know how to extract multiple, specific cell data from multiple closed workbooks that have the same worksheet format?
I am currently tasked to copy very specific data from certain cells from many different and new (but same format) sources and transfer them into another group of specific cells in an existing masterlist with different worksheets.
This is the code I wished would help, but it is lacking in too many ways as compared to what I need...
Sub Importsheet()
Dim Importsheet As Worksheet
'import worksheet from a closed workbook
Sheets.Add Type:= _
'e.g. directory below
"C:\Users\Loli\Desktop\Testing1.xlsx"
End Sub
This code helps me get the sheets out of the closed source workbook but not the specifically placed cells in the closed source excel. It also can't paste the data in specifically placed cells in different sheets in the destination excel.
It is very difficult to completely understand your requirements as it seems like sometimes you want to copy a range and some other times a single cell, so to point you in the right direction my answer only shows how to open and copy the relevant Sheet into your master workbook to then be able to reference the cell/ranges you want
(I would once you get your data then delete the Worksheet, so that your master doesn't suddenly becomes massive in size):
Sub ImportSheet()
Dim sImportFile As String, sFile As String
Dim sThisBk As Workbook
Dim vfilename As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sThisBk = ActiveWorkbook
sImportFile = Application.GetOpenFilename( _
FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Open Workbook") 'open dialog to choose the file you want, you can change this to loop through a folder if they are all in there.
If sImportFile = "False" Then 'check if a file was selected before importing
MsgBox "No File Selected!"
Exit Sub
Else
vfilename = Split(sImportFile, "\")
sFile = vfilename(UBound(vfilename))
Application.Workbooks.Open Filename:=sImportFile 'open the selected file
Set wbBk = Workbooks(sFile)
With wbBk
If SheetExists("Raw_Data") Then ' you should change this to the date, you can do this easily by using a variable such as if SheetExists(variableDate) then, where variableDate = "12/12/2017" or something similar
Set wsSht = .Sheets("Raw_Data")
wsSht.Copy before:=sThisBk.Sheets("Sheet1") 'copy the worksheet into your master
'WsSht.range("A1:B2").copy Destination:=sThisBk.Sheets("Temp").Range("A1").paste xlpastevalues 'use this to copy a specified range in this case A1:B2 to a sheet in master workbook called Temp A1
Else
MsgBox "There is no sheet with name :Raw_Data in:" & vbCr & .Name
End If
wbBk.Close SaveChanges:=False
End With
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Function SheetExists(sWSName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(sWSName)
If Not ws Is Nothing Then SheetExists = True
End Function

Why does VBA ActiveWorkbook.SaveAs change the open spreadsheet?

My function is as follows:
Sub saveCSV()
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"c:\temp\file.csv", FileFormat:=xlCSV _
, CreateBackup:=False
End Sub
I'm trying to export the active worksheet to CSV. When I run the code in the title, Book1.xlsm changes to file.csv and Sheet1 changes to file. The export works fine. How can I do the export without these unwanted side effects?
That's always how SaveAs has worked. The only way to get around this is to copy the worksheet and do a SaveAs on the copy, then close it.
EDIT: I should add an example as it's not that difficult to do. Here's a quick example that copies the ActiveSheet to a new workbook.
Dim wbk As Workbook
Set wbk = Workbooks.Add
ActiveSheet.Copy wbk.Sheets(1) ' Copy activesheet before the first sheet of wbk
wbk.SaveAs ....
wbk.Close
A complicated workbook may get issues with links and macros, but in ordinary scenarios this is safe.
EDIT 2: I'm aware of what you're trying to do, as your other question was about trying to trigger an export on every change to the sheet. This copy sheet approach presented here is likely to be highly disruptive.
My suggestion is to write a CSV file by hand to minimise GUI interruption. The sheet is likely to become unusable if the saves are occurring at high frequency. I wouldn't lay the blame for this at the door of Excel, it simply wasn't built for rapid saves done behind the scenes.
Here's a little routine that does what you want by operating on a copy of the original ... copy made via file scripting object. Hardcoded to operate on "ThisWorkbook" as opposed to active workbook & presumes ".xlsm" suffix - could tweak this to do the job I think:
Public Sub SaveCopyAsCsv()
Dim sThisFile As String: sThisFile = ThisWorkbook.FullName
Dim sCsvFile As String: sTempFile = Replace(sThisFile, ".xlsm", "_TEMP.xlsm")
ThisWorkbook.Save ' save the current workbook
' copy the saved workbook ABC.xlsm to TEMP_ABC.xlsm
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Call fso.deletefile(sTempFile, True) ' deletes prev temp file if it exists
On Error GoTo 0
Call fso.CopyFile(sThisFile, sTempFile, True)
' open the temp file & save as CSV
Dim wbTemp As Workbook
Set wbTemp = Workbooks.Open(sTempFile) ' open the temp file in excel
' your prev code to save as CSV
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:="c:\temp\file.csv", FileFormat:=xlCSV, CreateBackup:=False
wbTemp.Close ' close the temp file now that the copy has been made
Application.DisplayAlerts = True
' delete the temp file (if you want)
On Error Resume Next
Call fso.deletefile(sTempFile, True) ' deletes the temp file
On Error GoTo 0
End Sub

Resources