• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy Entire Rows from each sheet and paste it in another column in one column with Sheet name pasted against each field from where its being copied

ajoshi76

Member
Hi All,

I have multiple sheet - having data in Row 2 starting from A2 until some columns (some sheets have data till D, some have data till G etc..)
I would like a macro, which would copy the data of Row 2 (All columns having data) from all sheets and paste it transformed in Column A in Sheet "Output"

Output Sheet - Column B to be updated with Sheet name from which the Row 2 has been pasted.

Field Name (Column A)
Sheet Name (Column B)

Sample attached.

Any help much appreciated.

Regards
Ashish
 

Attachments

  • Book1.xlsm
    28.5 KB · Views: 3
Code:
Sub Transpose()
    Dim ws As Worksheet
    Dim s As Worksheet
    Set s = Sheets("Output")
    Application.ScreenUpdating = False
    Dim lr As Long, lc As Long
    For Each ws In Worksheets
        If ws.Name <> "Output" Or ws.Name <> "List" Then
            lc = ws.Cells(2, Columns.Count).End(xlToLeft).Column
            'ws.Range(Cells(2, 1), Cells(2, lc)).Copy
            ws.Range("A2").CurrentRegion.Copy
            lr = s.Range("A" & Rows.Count).End(xlUp).Row
            s.Range("A" & lr + 1).PasteSpecial xlPasteValues, , , True
            s.Range("B" & lr + 1) = ws.Name
        End If
    Next ws

    Dim i As Long
    lr = s.Range("A" & Rows.Count).End(xlUp).Row
    For i = 3 To lr
        If s.Range("B" & i) = "" Then s.Range("B" & i) = s.Range("B" & i - 1)
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "complete"
End Sub
 
Just noticed an error in my code

change this line:
If ws.Name <> "Output" Or ws.Name <> "List" Then
to

If ws.Name <> "Output" And ws.Name <> "List" Then
 
Have a small bug - the current Region copy copied my entire data in the sheet not only the 2nd row all columns. Can you please help?

ws.Range("A2").CurrentRegion.Copy (Copied all data from A2 below till the data exists in the sheet).

Require only to copy A2 to Last column in Row 2.
 
Last edited:
Just Another Option
Code:
Sub test()
    Dim sh, out As Worksheet
    Dim i, l As Long
    Set out = Sheets("Output")
    Application.ScreenUpdating = False
    ReDim a(1 To Sheets.Count - 2): ReDim b(1 To UBound(a))
    i = 1
    For Each sh In Worksheets
        If sh.Name <> "Output" And sh.Name <> "List" Then
            b(i) = sh.Name
            a(i) = Application.Transpose(sh.Cells(2, 1).CurrentRegion)
            i = i + 1
        End If
    Next
    With out
        .Cells(1, 1) = "Field Name": .Cells(1, 2) = "Sheet Name"
        For i = 1 To UBound(a)
            .Cells(2 + l, 1).Resize(UBound(a(i))) = a(i)
            .Cells(2 + l, 2).Resize(UBound(a(i))) = b(i)
            l = l + UBound(a(i))
        Next i
    End With
End Sub
 
THanks, It is showing blank rows for Sheet10 in the Output Sheet post macro execution

And it gave me subscript out of range for b(i) as there are 224 sheets to process
 
Last edited:
Hi
Code:
ReDim a(1 To Sheets.Count - 2): ReDim b(1 To UBound(a))
Should be
Code:
ReDim a(1 To Sheets.Count - 1): ReDim b(1 To UBound(a))
 

Attachments

  • 76.xlsm
    41.1 KB · Views: 4
Last edited:
If you had shown a sample that is representative of your actual file, this would not have happened. Lesson for the future: Make sure your sample is representative in the beginning so that we can provide you with a viable solution and not have to try and read your mind. We don't know what you know or have on your workbook unless you show us.
 
Hi
Code:
ReDim a(1 To Sheets.Count - 2): ReDim b(1 To UBound(a))
Should be
Code:
ReDim a(1 To Sheets.Count - 1): ReDim b(1 To UBound(a))
Let me check the spreadsheet - Still issues with 224 sheets - It says Subscript out of range
 
But in your sample there is only one row
so is it possible to upload the actual sample workbook with Non personal data?
 
BTW
My code Tested for 32 sheets + Output & hidden list sheet
(the layout in file uploaded in #1)>>Ok
 
Apologies to all who helped me on this - Next time onwards will ensure i provide the exact spreadsheet with the problem statement.
 
Back
Top