Code is only pasting header row into master sheet

[Svandra]

So, I have a workbook with a varying number of sheets. All have the same structure, number of columns, headers. What I want to do is put all the sheets together in 1 sheet. I've tried several codes but this one is the only one that doesn't give me an error message. However, it's only pasting the header lines and not pasting any of the data. But I want only 1 header line AND all the data from the other sheets in the master sheet. Can anyone help???

Sub CopyFromWorksheets()
    Dim wrk As Workbook 'Workbook object 
    Dim sht As Worksheet 
    Dim trg As Worksheet 
    Dim rng As Range
    Dim colCount As Integer 
     
    Set wrk = ActiveWorkbook     

    Application.ScreenUpdating = False
     
  
    Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.count))
    trg.name = "Master"
    Set sht = wrk.Worksheets(1)
    colCount = sht.Cells(1, 255).End(xlToLeft).Column
    With trg.Cells(1, 1).Resize(1, colCount)
        .Value = sht.Cells(1, 1).Resize(1, colCount).Value
         'Set font as bold
        .Font.Bold = True
    End With
     

    For Each sht In wrk.Worksheets
        If sht.Index = wrk.Worksheets.count Then
            Exit For
        End If
   
        Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
        trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.ROWS.count, rng.Columns.count).Value = rng.Value
    Next sht
    
    Application.ScreenUpdating = True
End Sub

 

[Svandra]

Did you try the code I suggested in Post #4?

Yes. It works but doesn't get all sheets and all the data Each sheet has around 650+ rows but - as you can see - it only gets 4 to 5 rows in some cases.

 

[Herakles]

Is the same the case with my code?

Can you show us one of the sheets that it only takes 4 to 5 rows from?

 

[mumps]

This line of code:

For x = 1 To Sheets.Count - 1

loops through all the sheets except the last sheet which is the Master so I don't understand why it doesn't get all the sheets. Also, the variable lRow finds the last used row in each sheet and copies all the data down to the last used row so i don't see how it doesn't get all the data. Please post a screenshot of one of the sheets as @Herakles suggested.

 

[Svandra]

This line of code:

For x = 1 To Sheets.Count - 1

loops through all the sheets except the last sheet which is the Master so I don't understand why it doesn't get all the sheets. Also, the variable lRow finds the last used row in each sheet and copies all the data down to the last used row so i don't see how it doesn't get all the data. Please post a screenshot of one of the sheets as @Herakles suggested.

Is there a way to upload the whole file? I can't get all 600+ rows in a screenshot.

 

[Herakles]

Just whatever you can do as I just want to look at the first 10 or so rows on a sheet that is failing.

 

[Svandra]

Is there a way to upload the whole file? I can't get all 600+ rows in a screenshot.

Here's a screenshot of the beginning and the end of such a sheet that only gets copied with 4-5 lines.

 

[Svandra]

Here's a screenshot of the beginning and the end of such a sheet that only gets copied with 4-5 lines.

This code copy/pastes all lines but doesn't get them at A1.

Sub CopyToMaster()
 
ShtCount = ActiveWorkbook.Sheets.count
 
For i = 2 To ShtCount
 
Worksheets(i).Activate
lastRow = activeSheet.Cells(ROWS.count, "K").End(xlUp).row
 
Range("A2:K" & lastRow).Select
 
Selection.Copy
Sheets("Master").Activate
 
lastRow = activeSheet.Cells(ROWS.count, "K").End(xlUp).Select
 
'Required after first paste to shift active cell down one
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
 
ActiveCell.Offset(0, -3).Select
Selection.PasteSpecial
 
 
Next i
End Sub

 

[mumps]

You could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[Herakles]

Same code as before basically (different sub name) but this will give you a message at the end giving you the range on each sheet where the data is coming from and the number of rows in the Master sheet before and after the data is written to it.

This may highlight where the problem is.

 

[Herakles]

Whoops! Here is the code I did not post with my previous post.

Public Sub subCopySheetsVersion2()
Dim wrk As Workbook
Dim sht As Worksheet
Dim trg As Worksheet
Dim lngCount As Long
Dim strMsg As String
Dim intRows As Integer

    ActiveWorkbook.Save

    Set wrk = ActiveWorkbook
    
    Application.DisplayAlerts = False
    wrk.Worksheets("Master").Delete
    Application.DisplayAlerts = True
    
    Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
    
    trg.Name = "Master"
    
    Sheets(1).Rows(1).EntireRow.Copy trg.Range("A1")
        
    For Each sht In wrk.Worksheets
        
        If sht.Name <> "Master" Then
        
            With sht.UsedRange
            
                intRows = .Rows.Count - 1
            
                strMsg = strMsg & vbCrLf & sht.Name & " " & sht.Range("A1").Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Address
                
                lngCount = lngCount + .Rows.Count - 1
                
                strMsg = strMsg & " " & Worksheets("Master").UsedRange.Rows.Count
                
                .Offset(1, 0).Copy Worksheets("Master").Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1)
    
                strMsg = strMsg & " " & Worksheets("Master").UsedRange.Rows.Count
                
            End With
        
        End If
   
    Next sht
    
    MsgBox strMsg, vbInformation, "Checks."
    
End Sub