combine 4 macros into a single one

[JohnExcel222]

Hi there,

I have 4 macros. Is it possible to combine them into a single one , or is it better to keep them separate call them one after each other ?

I would to get the following end result:

For each workseet in a folder:
- delete the empty sheets
- rename the first sheet after the workbook name (filename, without the extension)
- combine all the workbooks into a single one
- the combined workbook to same in the folder








Option Explicit

Sub A_1001_Prepare_Sheet()
'Insert column and Tab name
Dim ws As Worksheet
Dim Lastrow As Long
For Each ws In Sheets
With ws
Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
.Columns(1).Insert
.Range("A1:A" & Lastrow) = ws.Name
End With
Next ws
End Sub


Sub A_1002_MergeMultipleWorkbooks()

Dim Path, FileName As String

Path = "C:\Users\gabri\Documents\VBA Test Folder\Folder_01\Merge\"
FileName = Dir(Path & "*.xlsx")

Do While FileName <> ""

With Workbooks.Open(FileName:=Path & FileName, ReadOnly:=True)
.Worksheets(1).Copy After:=ThisWorkbook.Sheets(1)
.Close False
End With

FileName = Dir()
Loop

MsgBox "Files has been copied Successfull", , "MergeMultipleExcelFiles"
End Sub


Sub A_1003_DeleteSheets1()
Dim xWs As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In Application.ActiveWorkbook.Worksheets
'If xWs.Name <> "Sheet1" And xWs.Name <> "Sheet2" Then
If xWs.Name <> "Sheet1" Then
xWs.Delete
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub



Sub A_1004_Rename_Sheet_after_Workbook_Name()

Sheets(1).Name = ActiveWorkbook.Name
End Sub

 

[6StringJazzer]

It is possible to combine them into one but I don't see any advantage in doing that. I would just add one Main sub that calls all four of these.

 

[JohnExcel222]

It is possible to combine them into one but I don't see any advantage in doing that. I would just add one Main sub that calls all four of these.

Can you please help me with calling these 4 macros, to be applied to a folder?

 

[6StringJazzer]

Your code doesn't bear much relationship to what you described.

There is no need to delete the empty sheets if you are not going to save the workbook you are copying from.

This code creates a new workbook as the combined one. It was not clear if you wanted to copy the sheets into the same workbook with this code, or create a new one.

Sub CombineWorkbooks()

   Dim Path As String
   Dim FileName As String
   Dim Combined As Workbook
   
   Path = "C:\Users\gabri\Documents\VBA Test Folder\Folder_01\Merge\"
   
   Set Combined = Workbooks.Add
   Combined.SaveAs FileName:=Path & "Combined"
   
   
   FileName = Dir(Path & "*.xlsx")
   
   Do While FileName <> ""
   
      With Workbooks.Open(FileName:=Path & FileName, ReadOnly:=True)
      
         ' Copy the first sheet into combined workbook
         .Worksheets(1).Copy After:=Combined.Sheets(Combined.Sheets.Count)
         ' Rename sheet using the workbook name, without extension
         Combined.Worksheets(Combined.Sheets.Count).Name = Replace(.Name, ".xlsx", "")
         
         .Close False
         
      End With
      
      FileName = Dir()
   Loop

   Combined.Save
   
End Sub

 

[SpillerBD]

Sub Run_A_Procedures()
Call [I]ModuleName.ProcedureName[/I]
Call [I]ModuleName[/I].A_1001_Prepare_Sheet
Call [I]ModuleName[/I].A_1002_MergeMultipleWorkbooks
Call [I]ModuleName[/I].A_1003_DeleteSheets1
Call [I]ModuleName[/I].A_1004_Rename_Sheet_after_Workbook_Name
End Sub

 

[JohnExcel222]

Your code doesn't bear much relationship to what you described.

There is no need to delete the empty sheets if you are not going to save the workbook you are copying from.

This code creates a new workbook as the combined one. It was not clear if you wanted to copy the sheets into the same workbook with this code, or create a new one.

Sub CombineWorkbooks()

   Dim Path As String
   Dim FileName As String
   Dim Combined As Workbook
  
   Path = "C:\Users\gabri\Documents\VBA Test Folder\Folder_01\Merge\"
  
   Set Combined = Workbooks.Add
   Combined.SaveAs FileName:=Path & "Combined"
  
  
   FileName = Dir(Path & "*.xlsx")
  
   Do While FileName <> ""
  
      With Workbooks.Open(FileName:=Path & FileName, ReadOnly:=True)
     
         ' Copy the first sheet into combined workbook
         .Worksheets(1).Copy After:=Combined.Sheets(Combined.Sheets.Count)
         ' Rename sheet using the workbook name, without extension
         Combined.Worksheets(Combined.Sheets.Count).Name = Replace(.Name, ".xlsx", "")
        
         .Close False
        
      End With
     
      FileName = Dir()
   Loop

   Combined.Save
  
End Sub

The daily challange I need to face: keep up to date with work orders, which changing status, new additions, with poor data quality and parsed data extracts.....

The difficulties I had with these Procedures was to adapt the scope of these 4 procedures to workbooks within a folder, getting the information without opening the files.

I thank you for the help you provided.

 

[6StringJazzer]

Call [I]ModuleName.ProcedureName[/I]

If you want to apply formatting within code, you need to mark the code as Rich instead of VBA.