Error in Copying Dynamic Ranges with Static Number of Rows

[AlexB123]

Hi all,

I am using VBA to copy the first 10 rows (including Headers) of data in every sheet of a workbook to a "master", or summary, sheet. The number of columns changes from sheet to sheet, and the total number of sheets will change as well (over time). After I copy each selection, I want to transpose the data before pasting to my summary sheet, and then I want all data concatenated (just pasted one after the other with no gaps).

Here's what I have:

Sub Copy_Tpose_to_MSTR()
'The purpose of this macro is to copy the first ten rows, including headers, of every sheet to a single summary sheet.


Dim WB As Workbook
Dim SHT As Worksheet


Application.ScreenUpdating = False
    
    For Each SHT In WB.Worksheets
        If SHT.Name <> "Master" Then
            SHT.Range("A1:A10" & ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row.Select).Copy
            Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Transpose:=True
        End If
    Next
    
Application.ScreenUpdating = True
            
End Sub

Currently, I'm getting an "Error:424 - Object Required" on the line where I select the range of cells to copy. If you see any issues in the next line, I am all ears!

Thank you so much!!!

FYI - This is my second topic I've posted; it's been a while, but I hope to become an engaged member!

 

[Andrew Poulsom]

Try removing the .Select:

SHT.Range("A1:A10" & ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row.Select).Copy

 

[AlexB123]

Thanks Andrew,

That seems to have directed the debugger's attention elsewhere .... so that's a step in the right direction.

Now I'm getting an "error'91': Object Variable or With block variable not set" on the "For Each SHT In WB.Worksheets" line. Do I need place an "activate" command before the loop, or within the loop?

 

[Andrew Poulsom]

You haven't assigned a workbook object the the variable WB.

 

[AlexB123]

I added one line and was able to get the VBA to run, after removing "Select":

Set WB = ActiveWorkbook

However, the program did not transfer all the column names (now the first row cells), and it stopped at the first column of the second sheet. Can you suggest any problems/fixes? Could I provide a sample of the results?

Ex.
Sheet 1

1 Alex1 Alex2 Alex3 Alex4 Alex5
2 Jam1 Jam2 Jam3 Jame4 Jame5
3 Chri1 Chri2 Chr3 Chri4 Chri5

Master

Alex1 Jame1 Jame2
Alex2 Chris1 ........................................................................Chrisx & randomdata .....................
Alex3 Chris1 ........................................................................Chrisx & randomdata .....................


This is a really bad illustration, but essentially, the data that was copied was all added to two specific rows without getting the appropriate columns or in the specific order. Is there a simple way to improve my code?

Thanks!!!!

 

[AlexB123]

I tried to completely revise my code, based off some stuff I found on the MS website. It still fails because I cannot get "CopyRng" to work; that is, i cannot correctly set a range based off of rows A1:A10 and a varying number of columns. Any help with that is greatly appreciated!

Here is my second coding try:

Sub Copy_Tpose_to_MSTR()
'The purpose of this macro is to copy the first ten rows, including headers, of every sheet to a single summary sheet.


Dim WB As Workbook
Dim SHT As Worksheet
Dim DestSH As Worksheet 'This will be the summary worksheet
Dim Last As Long
Dim CopyRng As Range


With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With


Set WB = ActiveWorkbook


    'Delete the summary sheet if it exists.
    Application.DisplayAlerts = False
    On Error Resume Next
    WB.Worksheets("RDBMergeSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    'Add a new summary worksheet
    Set DestSH = WB.Worksheets.Add
    DestSH.Name = "RDBMergeSheet"
    
    'Loop through all worksheets and copy the data to summary sheet
    For Each SHT In WB.Worksheets
        If SHT.Name <> DestSH.Name Then
            
            'Find the last row with data on the summary sheet
            Last = LastRow(DestSH)
            
            'Find and set the range to be copied (for each sheet)
            Set CopyRng = SHT.Range("A1:A10", LastCol(SHT))
            
            'Paste sheet data to rest of data in the destination sheet
            CopyRng.Copy
            With DestSH.Cells(Last + 1, "A")
                .PasteSpecial Transpose:=True
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With
            
        End If
    Next


'Exit Sub and perform some final tasks


ExitTheSub:


    Application.Goto DestSH.Cells(1)
    
    'Autofit the column width in the summary sheet
    DestSH.Columns.AutoFit
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function

 

[Andrew Poulsom]

LastCol is returning a column number so try with the Cells property:

Set CopyRng = SHT.Range(SHT.Cells(1, 1), SHT.Cells(10, LastCol))

 

[AlexB123]

So, I just added (SHT) to LastCol (since it is a function)! And it worked!!!! Perfectly!!!!

You are amazing!!!! Thanks for your time Andrew!!!!

I was starting to get really frustrated with VBA

So, here is my final code...I've commented out some other lines I was trying out...but everything that isn't commented out works perfectly!

Sub Copy_Tpose_to_MSTR()
'The purpose of this macro is to copy the first ten rows, including headers, of every sheet to a single summary sheet.


Dim WB As Workbook
Dim SHT As Worksheet
Dim DestSH As Worksheet 'This will be the summary worksheet
Dim Last As Long
Dim CopyRng As Range
Dim num_cols As Long
Dim num_rows As Long


With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With


Set WB = ActiveWorkbook


    'Delete the summary sheet if it exists.
    Application.DisplayAlerts = False
    On Error Resume Next
    WB.Worksheets("RDBMergeSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    'Add a new summary worksheet
    Set DestSH = WB.Worksheets.Add
    DestSH.Name = "RDBMergeSheet"
    
    'Loop through all worksheets and copy the data to summary sheet
    For Each SHT In WB.Worksheets
        If SHT.Name <> DestSH.Name Then
            
            'Find the last row with data on the summary sheet
            Last = LastRow(DestSH)
            
            'Find and set the range to be copied (for each sheet); first find the number of rows and cols.
            'num_cols = LastCol(SHT)
            'num_rows = LastRow(SHT)
            
            'ActivateSheet.Select
            'If the number of rows is less than ten, use the number of rows. If only one row, skip.
            'If the number of rows is greater than ten, use only ten rows.
            'If num_rows > 10 Then
                'Set CopyRng = Range(Cells(1, 1), Cells(10, num_cols)).Select
                    'ElseIf num_rows < 10 And num_rows > 1 Then
                        'CopyRng = Range(Cells(1, 1), Cells(num_rows, num_cols)).Select
                            'Else
                                'CopyRng = Range(Cells(1, 1), Cells(1, num_cols)).Select
            'End If
            'Paste sheet data to rest of data in the destination sheet
             
            Set CopyRng = SHT.Range(SHT.Cells(1, 1), SHT.Cells(10, LastCol(SHT)))
             
            CopyRng.Copy
            With DestSH.Cells(Last + 1, "A")
                .PasteSpecial Transpose:=False
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With
            'Sheets(DestSH).Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Transpose:=True
            
            
            
        End If
    Next


'Perform some final tasks
Application.Goto DestSH.Cells(1)
    
'Autofit the column width in the summary sheet
DestSH.Columns.AutoFit
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function

 

[AlexB123]

Can I ask you one last question?

How did you know that function was returning a column number? I know that's what the function was designed to do ... but did you run it through a debugger, or set up a break point or anything? Or just pay attention to the code?

One ... more .... is there a way to mark this thread "solved"?

Grazie!

 

[Andrew Poulsom]

The function is using the Range object's Column property, and that returns a number.

You can't mark the thread solved. Saying that it is does the job.