Sub cmdCopy()
Dim wsDst As Worksheet, wsHours As Worksheet, wsTrack As Worksheet, worker As String, wsSrc As Worksheet, tblrow As ListRow
Dim Combo As String, sht As Worksheet, tbl As ListObject
Dim lastrow As Long, DocYearName As String, Site As String, lr As Long, HoursRow As Long, lrTrack As Long
Dim RowColor As Long, w As Window, r As Long, HoursRegister As String, ReportTracking As String
Application.ScreenUpdating = False
Set tbl = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting")
Set sht = ThisWorkbook.Worksheets("Costing_tool")
Site = ThisWorkbook.Worksheets("Start_here").Range("H9").Value
For Each tblrow In tbl.ListRows
If tblrow.Range.Cells(1, 1).Value = "" Or tblrow.Range.Cells(1, 5).Value = "" Or tblrow.Range.Cells(1, 6).Value = "" Then
MsgBox "The Date, Service or Requesting Organisation has not been entered for every record in the table"
Exit Sub
End If
Next tblrow
For Each tblrow In tbl.ListRows
Combo = tblrow.Range.Cells(1, 26).Value
If Not tblrow.Range(1, 8).Value = "" Then
worker = tblrow.Range.Cells(1, 8).Value
Else
worker = "Not allocated"
End If
HoursRegister = tblrow.Range.Cells(1, 38)
ReportTracking = tblrow.Range.Cells(1, 39)
Select Case Site
Case "W"
Select Case tblrow.Range.Cells(1, 6).Value
Case "AW", "AWAG", "AA", "ASC", "Y"
DocYearName = tblrow.Range.Cells(1, 37).Value
Case Else
DocYearName = tblrow.Range.Cells(1, 36).Value
End Select
Case "R"
Select Case tblrow.Range.Cells(1, 6).Value
Case "AW", "AWAG", "AA", "ASC", "Y"
DocYearName = tblrow.Range.Cells(1, 42).Value
Case Else
DocYearName = tblrow.Range.Cells(1, 36).Value
End Select
End Select
If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Work Allocation Sheets" & "\" & Site & "\" & DocYearName & ".xlsm"
If Not isFileOpen(ReportTracking & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Report Tracking" & "\" & Site & "\" & ReportTracking & ".xlsm"
Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
Set wsTrack = Workbooks(ReportTracking).Worksheets(Combo)
lr = wsDst.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
lrTrack = wsTrack.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
With wsTrack
tblrow.Range(, 1).Copy
.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
tblrow.Range(, 4).Copy
.Range("A" & Rows.Count).End(xlUp).Offset(, 1).PasteSpecial xlPasteValues
tblrow.Range(, 5).Copy
.Range("A" & Rows.Count).End(xlUp).Offset(, 2).PasteSpecial xlPasteValues
End With
With wsDst
.Columns("C:C").ColumnWidth = 8
tblrow.Range.Resize(, 7).Copy
.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
tblrow.Range(, 10).Copy
.Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
.Range("I" & Rows.Count).End(xlUp).Offset(1).Formula = "=IF(RC[-4]=""Activities"",0,RC[-1]*0.1)"
.Range("J" & Rows.Count).End(xlUp).Offset(1).Formula = "=RC[-1]+RC[-2]"
.Columns(8).NumberFormat = "$#,##0.00"
End With
Next tblrow
With wsDst.Sort
With .SortFields
.Clear
.Add Key:=wsDst.Range("A3"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
End With
.SetRange wsDst.Range("A3:AO" & lr)
.header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
With wsTrack.Sort
With .SortFields
.Clear
.Add Key:=wsTrack.Range("A1"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
End With
.SetRange wsTrack.Range("A1:I" & lrTrack)
.header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub