Excel VBA Macro to Combine or Merge or Consolidate All Sheets Data into One Sheet
'This is a very use full and User-friendly Macro which Copies the Active Data Range from Each sheet Into One Sheet[Consolidate].
Sub Consol_Sheets()
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
For Each WS In ThisWorkbook.Sheets
If WS.Name <> Sheets("Consolidate").Name Then
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
ThisWorkbook.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
End If
Next WS
End Sub
Note:
We can perform the same task purely using Loops.To know that method please go through following link.
Consolidate All Sheets Data Into One Sheet Using Loops
Thanks,Tamatam
'This is a very use full and User-friendly Macro which Copies the Active Data Range from Each sheet Into One Sheet[Consolidate].
Sub Consol_Sheets()
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
For Each WS In ThisWorkbook.Sheets
If WS.Name <> Sheets("Consolidate").Name Then
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
ThisWorkbook.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
End If
Next WS
End Sub
Note:
We can perform the same task purely using Loops.To know that method please go through following link.
Consolidate All Sheets Data Into One Sheet Using Loops
Thanks,Tamatam
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.