Not certain this is accurate but give it a go :
Private Sub BaselineCosts_Click()
Dim extr, month, year, checkm, checky As String
Dim colCount, rowCount As Integer
Dim ws2 As Worksheet
Dim tableh, tables, tabler, tablec, tabled As ListObject
Dim i, j, w, z As Long
Dim cFormula, str As String
Set ws2 = Worksheets("Baseline")
Set tableh = ws2.ListObjects("Table4")
Set tabled = ws2.ListObjects("Table3")
Set ws1 = Worksheets("Resources")
Set tabler = ws1.ListObjects("Table2")
Set ws3 = Worksheets("Actual and Forecast")
Set tables = ws3.ListObjects("Table7")
Set tablec = ws3.ListObjects("Table79")
Application.ScreenUpdating = False
With tableh.DataBodyRange
colCount = .Columns.Count
rowCount = .Rows.Count
End With
With tableh
For i = 7 To colCount
For j = 2 To rowCount + 1
str = Right(.HeaderRowRange(i).Value, 4)
cFormula = "=(XLOOKUP([@Resources],Table2[Resources],XLOOKUP(RIGHT(Table4[[#Headers],[" & .HeaderRowRange(i).Value & "]],4),Table2[[#Headers],[" & str & "]],Table2[" & str & "])))*(XLOOKUP([@Resources],Table2[Resources],XLOOKUP(Table4[[#Headers],[" & .HeaderRowRange(i).Value & "]],Table3[[#Headers],[" & .HeaderRowRange(i).Value & "]],Table3[" & .HeaderRowRange(i).Value & "])))"
'.Range.Cells(j, i) = cFormula
.Range.Cells(j, i).Select
Selection.NumberFormat = _
"_([$€-x-euro2] * #,##0.00_);_([$€-x-euro2] * (#,##0.00);_([$€-x-euro2] * ""-""??_);_(@_)"
Range("Table4[[#Totals],[" & .HeaderRowRange(i).Value & "]]").Select
Next j
.ListColumns(.HeaderRowRange(i).Value).TotalsCalculation = xlTotalsCalculationSum
Selection.NumberFormat = "_([$€-x-euro2] * #,##0.00_);_([$€-x-euro2] * (#,##0.00);_([$€-x-euro2] * ""-""??_);_(@_)"
Next i
End With
Sheets("Resources").Select
'Sheets("Sheet1").ListObjects("A_Table").Range.Select
Sheets("Resources").ListObjects("Table2").Range.Select
'Range("Table2").Select
Selection.Copy
Sheets("Actual and Forecast").Select
'Sheets("Actual and Forecast").Range("Table7[Actual and Forecast]").Select
Sheets("Actual and Forecast").ListObjects("Table7").Range.Select
ActiveSheet.Paste
Application.ScreenUpdating = True
'Application.CutCopyMode = False
End Sub