Saturday, 23 March 2013

How To Cobine or Merge or Consolidate or Import or Export Data From Multiple Workbooks Into One Sheet

Excel VBA Macro To Cobine 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
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

DataSource = "Source: [" & "Workbook Name:" & " " & ActiveWorkbook.Name & " " & _

"|" & "Sheet Name:" & " " & WS.Name & "|" & "Path :" & " " & ThisWorkbook.Path & "]"

LastDataRow = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByRows, _


LastDataColumn = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByColumns, _


Set MyDataRange = ActiveSheet.Range(Cells(1, 1).Offset(LastDataRow, 0), Cells(1, 1).Offset(0, LastDataColumn))



TargetDataRow = ActiveSheet.Cells.Find(what:="*", SearchOrder:=xlByRows, _

If TargetDataRow = "" Then

Cells(2, 1).Select
Cells(1, 1).Value = DataSource
Cells(1, 1).Font.Bold = True
Cells(TargetDataRow, 1).Offset(3, 0).Select
Cells(TargetDataRow, 1).Offset(2, 0).Value = DataSource
Cells(TargetDataRow, 1).Offset(2, 0).Font.Bold = True
End If

Next WS

ActiveWorkbook.Close SaveChanges:=False
SrcFileName = Dir() 'Allows to Go to Next File in a Directory

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


No comments:

Post a Comment

Hi User, Thank You for Visiting My Blog. Please Post Your Feedback/Comments/Query.

Subscribe to Blog Posts by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts