Extracting data from different worksheets in desired format

Hi,

I have momentarily 3 worksheet at the moment and will goes increasing datewise.Hence I want to extract those data which I have shown as sample in 3rd worksheet "Expected Result" format which I want.

Pls find enclosed in attachment.

Thanx in advance.

Maybe :

Sub Test()
  Dim wsTarget As Worksheet, wsTemp As Worksheet, rng As Range

  Application.ScreenUpdating = False
  Set wsTarget = Sheets("Expected Result")
  wsTarget.Rows("3:" & Application.Max(wsTarget.Cells.SpecialCells(xlCellTypeLastCell).Row, 3)).Clear

  For Each wsTemp In Worksheets
      With wsTemp
        If .Name <> wsTarget.Name Then
           .AutoFilterMode = False
           Set rng = .Range("A3:R" & .Cells(.Rows.Count, "A").End(xlUp).Row)
           rng.Columns("P").FormulaR1C1 = "=IF(R[-2]C1=""Type"",1,IF(OR(R[-2]C1=""Breakdown Details"",RC1=""""),"""",R[-1]C))"
           rng.Columns("Q").Value = .Name
           rng.Columns("R").FormulaR1C1 = "=IF(RC16=1,IF(R[-2]C1=""Type"",R[-2]C3,R[-1]C),"""")"
           rng.AutoFilter field:=16, Criteria1:=1

           Intersect(rng.SpecialCells(xlCellTypeVisible), .Columns("A:O")).Copy wsTarget.Cells(wsTarget.Rows.Count, "C").End(xlUp).Offset(1)
           Intersect(rng.SpecialCells(xlCellTypeVisible), .Columns("Q:R")).Copy wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1)

           .AutoFilterMode = False
           .Columns("P:S").Clear
        End If
      End With
  Next wsTemp

  wsTarget.Range("A2").CurrentRegion.Borders.Weight = xlThin
  Application.ScreenUpdating = True
End Sub

You are welcome, glad to help.


Regards