Correction in code to re arrange data

HI All

the result of the of the macro is in tab Capitalisation

Below macro filters the right data in Site_assumptions and arranges into Capitalisation tab

Example

AT2 Krottenbach Jul-71 New sites Nov-17


However i need to add in column F "Engineers" and "Site finders" per site and i don't know how to write that


Hence it has to look like :

AT2 Krottenbach Jul-71 New sites Nov-17 Engineers
AT2 Krottenbach Jul-71 New sites Nov-17 Site finders



manyb thanks!

Sub CAPITALISATION()
Application.ScreenUpdating = False
    Sheets("CAPITALISATION").Cells(1).CurrentRegion.Offset(1).ClearContents
    'the current region only works if the columns and rows next to it are blank
   With Sheets("SITE_ASSUMPTIONS").Range("p9").CurrentRegion
        .Parent.AutoFilterMode = False
        ' colum to filter is 4
        '7 is part of the formula is always 7
        .AutoFilter 4, Array("Renovation", "New sites"), 7
        .Copy Sheets("CAPITALISATION").Cells(1)
        .AutoFilter
    End With
End Sub

Hi your code only works for 1 site

it doesn't include the "Engineers" and "site finders" in code AT3

Code Name Opening Status Action date CAPITALISING COSTS
AT2 Krottenbach Jul-71 New sites Nov-17 Engineers
AT2 Krottenbach Jul-71 New sites Nov-17 Site Builders
AT3 Linz Lastenstrasse Feb-72 Renovation Apr-18


thanks in advance

AC

thanks anyway

THIS CODE WORKS BETTER

Sub CAPITALISATION():
Dim Lst As Long, n As Long
'Application.ScreenUpdating = False
    Sheets("CAPITALISATION").Cells(1).CurrentRegion.Offset(1).ClearContents
    'the current region only works if the columns and rows next to it are blank
   With Sheets("SITE_ASSUMPTIONS").Range("p9").CurrentRegion
        .Parent.AutoFilterMode = False
        ' colum to filter is 4
        '7 is part of the formula is always 7
        .AutoFilter 4, Array("Renovation", "New sites"), 7
        .Copy Sheets("CAPITALISATION").Cells(1)
        .AutoFilter
    End With
 With Sheets("CAPITALISATION")
  Lst = .Range("A" & Rows.Count).End(xlUp).Row
    For n = Lst To 2 Step -1
      With .Range("F" & n)
          .EntireRow.Copy
          .Offset(1).EntireRow.Insert
          .Resize(2).Value = Application.Transpose(Array("Engineers", "Site finders"))
     End With
     Next n
End With
End Sub