asked on

VBA Excel: Copy headers from multiple worksheets

Hello Experts,

I have a workbook with multiple worksheets.

I am looking for a procedure that convers the following requirements:

Copy and transpose the various headers from the various worksheets:
Report them in a Consolidation sheet like this :

Sheet1:

Sheet2:

Consolidation:

The filter should be done by Header and we can have the same header name in different worksheets

It would be great when I click in a cell of the Consolidation worksheet, to redirect to the field related.

Thank you again for your help.
Copy_Headers.xlsm

Rgonzo1971

Hi,

pls try

Sub macro()
Dim myArray
Dim DestRng As Range
For Each sh In Worksheets
    If sh.Name <> "Consolidation" Then
        Set OrigRng = sh.Range(sh.Range("A1"), sh.Cells(Cells.Columns.Count).End(xlToLeft))
        ReDim myArray(OrigRng.Count - 1, 2)
        For Idx = 0 To OrigRng.Count - 1
            myArray(Idx, 0) = OrigRng.Cells(1, Idx + 1)
            myArray(Idx, 1) = Split(OrigRng.Cells(1, Idx + 1).Address, "$")(1)
            myArray(Idx, 2) = sh.Name
        Next

        Set DestRng = Sheets("Consolidation").Range("A" & Cells.Rows.Count).End(xlUp).Offset(1)
        Set DestRng = DestRng.Resize(UBound(myArray, 1) + 1, UBound(myArray, 2) + 1)
        DestRng = myArray
    End If
Next
Sheets("Consolidation").Columns("A:C").Sort key1:=Range("A2"), _
      order1:=xlAscending, Header:=xlYes
      
For Each c In Sheets("Consolidation").Range(Range("A2"), Range("A" & Cells.Rows.Count).End(xlUp)) '=HYPERLINK("#Sheet2!B2","Budget")
    c.Formula = "=HYPERLINK(" & Chr(34) & "#" & c.Offset(, 2).Value & "!" & c.Offset(, 1) & "1" & Chr(34) & "," & Chr(34) & c.Value & Chr(34) & ")"
Next
End Sub

Open in new window

Regards

Luis Diaz

ASKER

Hello,

Thank you for this code.

I will test it in a while.

Luis Diaz

ASKER

I have tested and it works.

I have some remarks:
-Is there a way to add Consolidation if it doesn't exist
-Clear UsedRange of Consolidation otherwise when I change the header name of one sheet because when I relaunch the macro I have the previous headers which are kept
-Apply borders of UsedRange and deactivate gridlines for all Worksheets in Workbook

Thank you again for your help.

ASKER CERTIFIED SOLUTION

Rgonzo1971

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Luis Diaz

ASKER

I tested and it works, thank you again for your help.