We had a requirement of combining all workbooks (Not work sheets) which are available in a folder, into one worksheet.
Condition: Combine only with Sheetname "Updated" from all available Excel workbooks.
As I am not a very good VBA programmer, I could do this in two steps.
Step1:
Combine all excel worksheets into one by executing another VBA script as below.
Condition: Combine only with Sheetname "Updated" from all available Excel workbooks.
As I am not a very good VBA programmer, I could do this in two steps.
Step1:
- Copy below script into a new excel module where all workbook data has to combine
- Execute script to loop through all excels, select and copy sheetname having "Updated" to current workbook
- Worksheets will be copied in different worksheets as Updated1, Updated2, Updated3 etc.. under current workbook
Sub GetSheets()
Path = "D:\AllWorkbooksFolder\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
' For Each Sheet In ActiveWorkbook.Sheets
Sheets("Updated").Select
Sheets("Updated").Copy After:=ThisWorkbook.Sheets(1)
' Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub
Step2: Path = "D:\AllWorkbooksFolder\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
' For Each Sheet In ActiveWorkbook.Sheets
Sheets("Updated").Select
Sheets("Updated").Copy After:=ThisWorkbook.Sheets(1)
' Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub
Combine all excel worksheets into one by executing another VBA script as below.
Sub CombineSheets()
Dim ws As Worksheet, wsCombine As Worksheet
Dim rg As Range
Dim RowCombine As Integer
Set wsCombine = ThisWorkbook.Worksheets.Add(ThisWorkbook.Worksheets(1))
wsCombine.Name = "Combine"
RowCombine = 1
For Each ws In ThisWorkbook.Worksheets
If ws.Index <> 1 Then
Set rg = ws.Cells(1, 1).CurrentRegion
rg.Copy wsCombine.Cells(RowCombine, 2)
wsCombine.Range(Cells(RowCombine, 1), Cells(RowCombine + rg.Rows.Count - 1, 1)).NumberFormat = "@"
wsCombine.Range(Cells(RowCombine, 1), Cells(RowCombine + rg.Rows.Count - 1, 1)) = ws.Name
RowCombine = RowCombine + rg.Rows.Count
End If
Next
wsCombine.Cells(1, 1).EntireColumn.AutoFit
Set rg = Nothing
Set wsCombine = Nothing
End Sub
Dim ws As Worksheet, wsCombine As Worksheet
Dim rg As Range
Dim RowCombine As Integer
Set wsCombine = ThisWorkbook.Worksheets.Add(ThisWorkbook.Worksheets(1))
wsCombine.Name = "Combine"
RowCombine = 1
For Each ws In ThisWorkbook.Worksheets
If ws.Index <> 1 Then
Set rg = ws.Cells(1, 1).CurrentRegion
rg.Copy wsCombine.Cells(RowCombine, 2)
wsCombine.Range(Cells(RowCombine, 1), Cells(RowCombine + rg.Rows.Count - 1, 1)).NumberFormat = "@"
wsCombine.Range(Cells(RowCombine, 1), Cells(RowCombine + rg.Rows.Count - 1, 1)) = ws.Name
RowCombine = RowCombine + rg.Rows.Count
End If
Next
wsCombine.Cells(1, 1).EntireColumn.AutoFit
Set rg = Nothing
Set wsCombine = Nothing
End Sub
No comments:
Post a Comment