I'm trying to make a VBA that would open multiple workbooks ( only one also), copy all their sheets in another workbook. I want to make my code functional directly from PersonalWorkbook so that i can use it in any new workbook that i want.
I know it's not a lot, but i got stucked with these incomplete versions (second one is not working as intended at all)...
Sub conso()
Dim folderpath As String
Dim file As String
Dim i As Long
folderpath = InputBox("Please paste the folder path", "Choose Folder") & "\"
file = Dir(folderpath)
Do While file <> ""
Workbooks.Open folderpath & file
ActiveWorkbook.Worksheets(1).Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
'ActiveSheet.Name = Right(Left(file, Len(file) - 5), Len(Left(file, Len(file) - 5)) - InStr(1, Left(file, Len(file) - 5), "("))
'ActiveSheet.Name = file
ActiveSheet.Name = Left(file, InStr(file, ".") - 1)
Workbooks(file).Close
file = Dir()
Loop
End Sub
Second:
Sub open_and_copy_sheets()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim my_FileName As Variant
Dim nm As String
Dim nm2 As String
Dim i As Integer
nm = ActiveWorkbook.Name
my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")
If my_FileName <> False Then
Workbooks.Open Filename:=my_FileName
End If
Workbooks(Workbooks.Count).Activate
nm2 = ActiveWorkbook.Name
For i = 1 To Workbooks(nm2).Worksheets.Count
Sheets(i).Copy after:=Workbooks(nm).Sheets(Workbooks(nm).Sheets.Count)
Next i
Workbooks(nm2).Close SaveChanges:=False
Workbooks(nm).Activate
Worksheets(1).Activate
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Any help would be greately appreciated! I'm not that good in vba so any explanation would also be welcomed :)
If you want the function to be available in your PersonalWorkbook, then create a "Module" underneath your Personal.XLSB via the VBA Editor (see screen grab). I've fixed your code a little:
It's a little more compact than you had, which had one or two errors, also the code was continuing to attempt to copy even if no destination workbook was selected. You will just need to add a line to save the final new workbook (you could use the "index" variable to see if it is > 1 as a check to see if there is anything to save. "Option Explicit" is a good idea to have at the top of the module, it checks your code to make sure that any variable you use has explicitly been declared, which helps to avoid typing errors.
UPDATE HERE IS A COMPLETE SOLUTION:
You need to break this down into separate chunks to get what you want.
STEP 1 - Ask the user whether they are copying sheets to a single file or multiples:
STEP 2: Add two functions, one for copying multiples and one for singles:
STEP 3: Finally, a function that takes a source workbook and destination file to copy the sheets, which can be called from either of the previous two functions: