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 "Life Without Barriers", "Lifestyle Solutions", "Live Better", "Other", "Veritas House"
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 "Life Without Barriers", "Lifestyle Solutions", "Live Better", "Other", "Veritas House"
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
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
lrTrack = wsTrack.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
wsTrack.Sort.SortFields.Clear
wsTrack.Sort.SortFields.Add Key:=Range("A2:I" & lrTrack), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Workbooks(ReportTracking).Worksheets(Combo).Sort
.SetRange Range("A1:I" & lrTrack)
.header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
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"
lr = wsDst.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
wsDst.Sort.SortFields.Clear
wsDst.Sort.SortFields.Add Key:=Range("A4:A" & lr), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Workbooks(DocYearName).Worksheets(Combo).Sort
.SetRange Range("A3:AO" & lr)
.header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
Next tblrow
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub