Transpose and copy from one sheet to another

[jayped]

Hi, I would like a macro that auto populates a master sheet in a workbook based on two other sheets, sheet 1 and sheet 2, which will act as templates. The master sheet will have normal column headers horizontally but in sheets 1 and 2, the headings will be contained in column A and the data in column B. The labels in column A in sheets 1 and 2 will vary but the master sheet will have all the fields from both sheets. When either sheet 1 or 2 is updated, I would like to run a macro which populates the next available row in the master sheet by transposing, copying and pasting the data in column B, while matching the labels in column A with the headers in the master sheet. Sheet 1 and sheet 2 can have separate macros if necessary.


Thanks!

 

[tonyyy]

You might consider the following...

Sub TransposeAndCopy()
Dim LastRow As Long, LastColumn As Long, i As Long, j As Long
Dim r As Range
Dim arr(2) As Variant

arr(0) = "Sheet1"
arr(1) = "Sheet2"
LastColumn = Sheets("Master").Cells(1, Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
For i = 0 To 1
    For Each r In Sheets(arr(i)).Range("A1:A" & Sheets(arr(i)).Cells(Rows.Count, "A").End(xlUp).Row)
        If Not IsError(Application.Match(r.Value, Sheets("Master").Range(Cells(1, 1), Cells(1, LastColumn)), 0)) Then
            j = Application.Match(r.Value, Sheets("Master").Range(Cells(1, 1), Cells(1, LastColumn)), 0)
            LastRow = Sheets("Master").Cells(Rows.Count, j).End(xlUp).Row
            Sheets("Master").Cells(LastRow + 1, j).Value = r.Offset(0, 1).Value
        Else
            MsgBox r.Value & " not found"
        End If
    Next r
Next i
Application.ScreenUpdating = True
End Sub

Cheers,

Tony