Copy a column from multiple sheets paste transpose as a row

[Mel2016]

Hi, what I am trying to do is copy column B (b2:b:19) from all sheets in the workbook (100) and paste/ transpose its one row per record. Each sheet is named with the employee so each has unique data.

The following code works except it's only copying the last worksheet's data in the file to the master sheet instead of starting with the first sheet. I've looked at it too much so any help is greatly appreciated.

Sub TransposeColtoRow()

Dim ws As Worksheet


Application.ScreenUpdating = False
Sheets("Master").Activate

For Each ws In Worksheets
If ws.Name <> "Master" Then
ws.Range("B2:B19").Copy
ActiveSheet.Paste Range("A65536").End(xlUp).Offset(1, 0)
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False



End If

Next ws




End Sub

 

[Mel2016]

Thanks for your help but it's working but funky. all the data I want is there but also includes the column data too. Strange.

 

[Joe4]

I am not sure I understand what you are saying. Can you explain a specific example, and what is happening?

 

[Mel2016]

This what it looks like. All the data is there I don't get why it copied all fields into column a and then transposed it. It seems to copy the col data after it transposes the data into a row.
ColumnA column b. Col D Col E
Smith dob doh address
dob
doh
address

 

[Joe4]

Not sure why it would do that. I cannot recreate that behavior. Maybe you are on a different version of Excel. However, we can try to explicitly delete any of that extra data.
Try this:

Sub TransposeColtoRow()

    Dim ws As Worksheet

    Application.ScreenUpdating = False

    For Each ws In Worksheets
        If ws.Name <> "Master" Then
            ws.Range("B2:B19").Copy
            Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=True
            Application.CutCopyMode = False
            ActiveCell.Offset(1, 0).Resize(18, 1).ClearContents
        End If
    Next ws
    
    Application.ScreenUpdating = True

End Sub

 

[Mel2016]

That worked perfectly. So that understand it- it pulls all the data then clears/deletes the column data? What does that last statement do-activecell. Resize?

Thanks again for for the help !

 

[Joe4]

What that does is move one cell before where we just did the "transpose paste" (that is the OFFSET part), and then the RESIZE part is also select the 18 rows below that.
Then we are deleting all those contents. So anything that is left over below the cell we pasted to is cleaned up/removed.

If you do a Google Search on "Excel VBA Offset" and "Excel VBA Resize", you can find out more information on those functions.

 

[Mel2016]

Thanks again