Excel VBA Macro To Combine or Merge or Consolidate or Import or Export Data from All Sheets of Multiple Workbooks Into Single Sheet of Another New Workbook
Sub Consol_All_Books2OneSheet()
Dim LastDataRow As Long
Dim LastDataColumn As Long
Dim MyDataRange As Object
Dim WS As Worksheet
Dim DataSource As String
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
On Error Resume Next
Export2File = Format(Now(), " DD_MM_YYYY HH-MM AMPM ")
'Target File location into which files are to be Merge.....Change as you wish.......
Workbooks.Add(xlWBATWorksheet).SaveAs FileName:="D:\MBA\" & Export2File & ".xlsm ", FileFormat:=52
'FileFormat:=xlOpenXMLWorkbookMacroEnabled
Set TargetFile = ActiveWorkbook
ActiveWorkbook.Sheets(1).Name = "Consolidate"
'Source File location from which files are to be Export.....Change as you wish.......
SourcePath = "C:\Documents and Settings\Administrator\My Documents\"
SrcFileName = Dir(SourcePath & "*.xls*")
Do While SrcFileName <> ""
Set SourceFile = Workbooks.Open(FolderPath & SrcFileName)
'With SourceFile
' .UpdateLinks = xlUpdateLinksNever 'never update links
' .UpdateRemoteReferences = False 'never update remote workbook
'End With
For Each WS In SourceFile.Sheets
WS.Activate
DataSource = "Source: [" & "Workbook Name:" & " " & ActiveWorkbook.Name & " " & _
"|" & "Sheet Name:" & " " & WS.Name & "|" & "Path :" & " " & ThisWorkbook.Path & "]"
LastDataRow = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
LastDataColumn = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Set MyDataRange = ActiveSheet.Range(Cells(1, 1).Offset(LastDataRow, 0), Cells(1, 1).Offset(0, LastDataColumn))
MyDataRange.Copy
TargetFile.Sheets("Consolidate").Activate
TargetDataRow = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
If TargetDataRow = "" Then
Cells(2, 1).Select
ActiveSheet.Paste
Cells(1, 1).Value = DataSource
Cells(1, 1).Font.Bold = True
Else:
Cells(TargetDataRow, 1).Offset(3, 0).Select
ActiveSheet.Paste
Cells(TargetDataRow, 1).Offset(2, 0).Value = DataSource
Cells(TargetDataRow, 1).Offset(2, 0).Font.Bold = True
End If
Next WS
SourceFile.Activate
ActiveWorkbook.Close SaveChanges:=False
SrcFileName = Dir() 'Allows to Go to Next File in a Directory
Loop
TargetFile.Close SaveChanges:=True
Application.EnableEvents = True
Application.DisplayAlerts = True
MsgBox "All Wokbooks with All Sheets Successfllly Exported To Target File Sheet", vbInformation, "Successfully Exported !"
End Sub
Sub Consol_All_Books2OneSheet()
Dim LastDataRow As Long
Dim LastDataColumn As Long
Dim MyDataRange As Object
Dim WS As Worksheet
Dim DataSource As String
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
On Error Resume Next
Export2File = Format(Now(), " DD_MM_YYYY HH-MM AMPM ")
'Target File location into which files are to be Merge.....Change as you wish.......
Workbooks.Add(xlWBATWorksheet).SaveAs FileName:="D:\MBA\" & Export2File & ".xlsm ", FileFormat:=52
'FileFormat:=xlOpenXMLWorkbookMacroEnabled
Set TargetFile = ActiveWorkbook
ActiveWorkbook.Sheets(1).Name = "Consolidate"
'Source File location from which files are to be Export.....Change as you wish.......
SourcePath = "C:\Documents and Settings\Administrator\My Documents\"
SrcFileName = Dir(SourcePath & "*.xls*")
Do While SrcFileName <> ""
Set SourceFile = Workbooks.Open(FolderPath & SrcFileName)
'With SourceFile
' .UpdateLinks = xlUpdateLinksNever 'never update links
' .UpdateRemoteReferences = False 'never update remote workbook
'End With
For Each WS In SourceFile.Sheets
WS.Activate
DataSource = "Source: [" & "Workbook Name:" & " " & ActiveWorkbook.Name & " " & _
"|" & "Sheet Name:" & " " & WS.Name & "|" & "Path :" & " " & ThisWorkbook.Path & "]"
LastDataRow = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
LastDataColumn = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Set MyDataRange = ActiveSheet.Range(Cells(1, 1).Offset(LastDataRow, 0), Cells(1, 1).Offset(0, LastDataColumn))
MyDataRange.Copy
TargetFile.Sheets("Consolidate").Activate
TargetDataRow = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
If TargetDataRow = "" Then
Cells(2, 1).Select
ActiveSheet.Paste
Cells(1, 1).Value = DataSource
Cells(1, 1).Font.Bold = True
Else:
Cells(TargetDataRow, 1).Offset(3, 0).Select
ActiveSheet.Paste
Cells(TargetDataRow, 1).Offset(2, 0).Value = DataSource
Cells(TargetDataRow, 1).Offset(2, 0).Font.Bold = True
End If
Next WS
SourceFile.Activate
ActiveWorkbook.Close SaveChanges:=False
SrcFileName = Dir() 'Allows to Go to Next File in a Directory
Loop
TargetFile.Close SaveChanges:=True
Application.EnableEvents = True
Application.DisplayAlerts = True
MsgBox "All Wokbooks with All Sheets Successfllly Exported To Target File Sheet", vbInformation, "Successfully Exported !"
End Sub
-------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------
No comments:
Post a Comment
Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.