Sub RunAllMacros()
Dim Sourcesheet As Worksheet
Set Sourcesheet = ThisWorkbook.Worksheets("Client Summary")
ClearContents
addHeaders
CopyDataWithoutHeaders
Call Sourcesheet.Activate
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
Sub ClearContents()
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("MergeSheet").Cells.ClearContents
Application.ScreenUpdating = True
End Sub
Sub addHeaders()
Dim ws As Worksheet
Dim headers() As Variant
'Define worksheet and desired headers
Set ws = ThisWorkbook.Sheets("MergeSheet")
headers() = Array("Staff Name", "Client", "ER", "Hours", "Comments", "Other")
'Insert headers
With ws
For i = LBound(headers()) To UBound(headers())
.Cells(1, 1 + i).Value = headers(i)
Next i
.Rows(1).Font.Bold = True
.Rows(1).Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
End Sub
Sub CopyDataWithoutHeaders()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim LastDest As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long
'set references up front
Set DestSh = ThisWorkbook.Worksheets("MergeSheet")
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Fill in the start row.
StartRow = 5
' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
If sh.Name <> "Staff Summary" Then
If sh.Name <> "Client Summary" Then
If sh.Name <> "Helpers" Then
' Find the last row with data on the summary
' and source worksheets.
Last = LastRow(DestSh)
shLast = LastRow(sh)
' If source worksheet is not empty and if the last
' row >= StartRow, copy the range.
If shLast > 0 And shLast >= StartRow Then
'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
' Test to see whether there are enough rows in the summary
' worksheet to copy all the data.
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the " & _
"summary worksheet to place the data."
GoTo ExitTheSub
End If
' This statement copies values and formats.
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
' Optional: This statement will copy the sheet
' name in the A column.
DestSh.Cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Name
End If
End If
End If
End If
End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
' AutoFit the column width in the summary sheet.
DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
