JohnExcel222
New Member
- Joined
- Dec 19, 2018
- Messages
- 35
- Office Version
- 365
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
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