Hi,
Thank you for the reply. It works with the modified Wardwise sheet and the code above.
I need a few more favors from you.
1. The rows which contain the Word "Total" are not needed. Either they can be deleted or skipped from copying from the respective sheets. Can you modify the code to meet out this need?
2. Sorting has to be done in the following order.
(i) Column D
(ii) Column C
(iii) Column B
3. I want to know the changes you made to the "Wardwise" sheet in order to adopt the same technique wherever needed.
I thank you once again for your help.
For number 1:
I will add a loop to look for the word "*Total*", then delete entire row if found.
VBA Code:
'remove row contains TOTAL
Dim d As Long 'row number
d = 6
Do Until d = data_lastrow 'loop through each row
If wsD.Cells(d, 2).Value Like "*" & "Total" & "*" Then
wsD.Rows(d).EntireRow.Delete
Else
d = d + 1
End If
Loop
For number 2:
Here is how I have coded the sequence of sorting:
wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("D5"), Order1:=xlAscending, Header:=xlYes
wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("C5"), Order1:=xlAscending, Header:=xlYes
wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlYes
Which is Column D -> Column C -> Column B.
If this is not the end product you wanted, try swap the Column D with Column B. like this:
wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlYes
wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("C5"), Order1:=xlAscending, Header:=xlYes
wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("D5"), Order1:=xlAscending, Header:=xlYes
For number 3:
From your original "Wardwise" sheet, simply select cell B4:D5, then click "Unmerge".
Then Cut word from cell B4:D4, and Paste into cell B5:D5, so that they become the table header just like the rest of the header (Row5).
Here is my updated code:
VBA Code:
Option Explicit
Sub MergeSheets3()
Dim wsD As Worksheet
Dim ws As Worksheet
Set wsD = ThisWorkbook.Sheets("Wardwise")
'delete previous data
wsD.Range("B6:R10000").Clear
Dim data_lastrow As Long
Dim FoundCell As Range
Dim data_lastrow1 As Long
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Wardwise" Then
Else
'unmerge all cells
ws.Range("B8:R10000").UnMerge
'count the lastrow of each sheets
data_lastrow = wsD.Cells(Rows.Count, 4).End(xlUp).Row + 1
'Find net total as last row
Const WHAT_TO_FIND As String = "Net Total"
Set FoundCell = ws.Range("B:B").Find(What:=WHAT_TO_FIND)
data_lastrow1 = FoundCell.Row
'copy sheets into Destination sheet
ws.Range("C8:Q" & data_lastrow1).Copy Destination:=wsD.Range("D" & data_lastrow)
ws.Range("B8:B" & data_lastrow1).Copy Destination:=wsD.Range("B" & data_lastrow)
wsD.Range("C" & data_lastrow & ":C" & data_lastrow + data_lastrow1 - 8).Value = ws.Name
End If
Next ws
'refresh last row of destination sheet
data_lastrow = wsD.Cells(Rows.Count, 3).End(xlUp).Row + 1
'remove row contains TOTAL
Dim d As Long 'row number
d = 6
Do Until d = data_lastrow 'loop through each row
If wsD.Cells(d, 2).Value Like "*" & "Total" & "*" Then
wsD.Rows(d).EntireRow.Delete
Else
d = d + 1
End If
Loop
'sort order D then C then B, change this for your preferences
wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("D5"), Order1:=xlAscending, Header:=xlYes
wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("C5"), Order1:=xlAscending, Header:=xlYes
wsD.Range("B5:R" & data_lastrow).Sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlYes
wsD.AutoFilterMode = False
Set wsD = Nothing
Set ws = Nothing
MsgBox "Done merged"
End Sub
