consolidate sheets vertical to horizontal (but only certain cells, yellow filled)

[erdow]

Hi to all experts,

I have a workbook with multiple sheets with same structure. What i want to do is consolidate only the specific cells with same header **using vba**(from vertical to horizontal)
Report is between A1:AN96 veritically, i need a1 and then horizotally AL6-AL20-AL24-AL26-................
If it is difficult to get only yellow cells then you can get costumer name to A1 and then AL&AM (i just need yearly data column not monthlys) next to it (b1-c1-d1-......) and the other costumers after the other (a2-a3-a4....) and i can filter according to my needs..
There ise a sample file on the link
I need to consolidate yellow cells..
Thanks a lot in advance...

 

[erdow]

Optimization for S as a constant :​

Sub Demo1()
    Const E = """)", S = "=INDIRECT(""'""&$A2&""'!$"
    Dim R&
    UsedRange.Offset(1).Clear
    Application.ScreenUpdating = False
    For R = 1 To Index - 1:  Cells(R + 1, 1).Value2 = Sheets(R).Name:  Next
    Range(Replace("B2:C#,E2:E#,G2:G#,J2:J#", "#", R)).NumberFormat = "#,##0_W"
    Range(Replace("D2:D#,I2:I#", "#", R)).NumberFormat = "#,##0.00_W"
    Range(Replace("F2:F#,H2:H#,K2:K#", "#", R)).NumberFormat = "0.00%_W"
    Range("B2:K" & R).Formula = Array(S & "AL$6" & E, S & "AL$20" & E, S & "AL$24" & E, S & "AL$26" & E, S & "AM$26" & E, _
                                     S & "AL$30" & E, S & "AM$30" & E, S & "AL$40" & E, S & "AL$63" & E, S & "AM$63" & E)
    Application.ScreenUpdating = True
End Sub

Thank you so much Marc..

 

[erdow]

Simplify i + 1

Sub ConsolidateSheets()
  Dim i As Long, n As Long
  For i = 1 To Sheets.Count - 1: n = i + 1
    Range("A" & n).Value = Sheets(i).Name
    Range(Replace("B#:E#,G#,I#:J#", "#", n)).Formula = "=VLOOKUP(R1C,'" & Sheets(i).Name & "'!C9:C38,30,0)"
    Range(Replace("F#,H#,K#", "#", n)).Formula = "=VLOOKUP(R1C[-1],'" & Sheets(i).Name & "'!C9:C39,31,0)"
  Next
  Range("B2:K" & n).Value = Range("B2:K" & n).Value
End Sub

Dante Amor thank you so much, i am using this version and works fine. If you can show to how can i exclude one or more specific sheets from consolidation i will be gratefull...

 

[DanteAmor]

how can i exclude one or more specific sheets

Try this:

Sub ConsolidateSheets()
  Dim i As Long, n As Long
  For i = 1 To Sheets.Count - 1: n = i + 1
    Select Case Sheets(i).Name
      Case "Sheet1", "Sheet2", "etc" 'exclude one or more specific sheets
      Case Else
      Range("A" & n).Value = Sheets(i).Name
      Range(Replace("B#:E#,G#,I#:J#", "#", n)).Formula = "=VLOOKUP(R1C,'" & Sheets(i).Name & "'!C9:C38,30,0)"
      Range(Replace("F#,H#,K#", "#", n)).Formula = "=VLOOKUP(R1C[-1],'" & Sheets(i).Name & "'!C9:C39,31,0)"
    End Select
  Next
  Range("B2:K" & n).Value = Range("B2:K" & n).Value
End Sub

 

[erdow]

Try this:

Sub ConsolidateSheets()
  Dim i As Long, n As Long
  For i = 1 To Sheets.Count - 1: n = i + 1
    Select Case Sheets(i).Name
      Case "Sheet1", "Sheet2", "etc" 'exclude one or more specific sheets
      Case Else
      Range("A" & n).Value = Sheets(i).Name
      Range(Replace("B#:E#,G#,I#:J#", "#", n)).Formula = "=VLOOKUP(R1C,'" & Sheets(i).Name & "'!C9:C38,30,0)"
      Range(Replace("F#,H#,K#", "#", n)).Formula = "=VLOOKUP(R1C[-1],'" & Sheets(i).Name & "'!C9:C39,31,0)"
    End Select
  Next
  Range("B2:K" & n).Value = Range("B2:K" & n).Value
End Sub

Perfect You made my task so easy... Thank you so much again and again and again.....

 

[DanteAmor]

Glad we could help & thanks for the feedback