Create a summary of different worksheets, leaving out empty cells, starting from row 12

[NewBee_HS]

Dear Excel-specialists,

I have a short question.
I have 1 master workbook that contains several worksheets, including a Summary worksheet.
The header for each worksheet is the same (from row 1:11). This also counts for the Summary sheet.

What I like to achieve is:
- walk through all worksheets in the workbook (could have different names) except the worksheet with the name "Summary"
- Copy all data that lives (per column A:Z) in all worksheets starting from row 12 until there is no data found
- Make a summary of all collected data, leaving empty cells out and put this in the summary worksheet also starting from row 12

Result: A summary of all the data from the worksheets starting from row 12.

My problem: The script gives not the desired result in the summary worksheet.
Column D stays empty (priority 3) and the word "Integration complexity" Cell H9 is also copied.

Can somebody help me out please?
Code an sheet is included.

Thank you in advance!

Best regards,

Hans

Sub CopyWorkSheetDataWithoutOverwritingHeader()
   Dim summarySheet As Worksheet
   Dim dataSheet As Worksheet
   Dim lastRow As Long
   Dim summaryRow As Long
   Dim columnRange As Range
   Dim cell As Range
   Dim startRow As Long
   
   Set summarySheet = ThisWorkbook.Sheets("Summary")
   startRow = 12
   
   summarySheet.Activate
   summarySheet.Visible = True
   
   summarySheet.Range("A" & startRow & ":Z3500").ClearContents ' Clear rows
   
   For Each dataSheet In ThisWorkbook.Sheets
      If dataSheet.Name <> "Summary" Then
         ' Loop through each column from B to Z
         For Each columnRange In dataSheet.Range("B:Z").Columns
            summaryRow = summarySheet.Cells(summarySheet.Rows.Count, columnRange.Column).End(xlUp).Row + 1
            lastRow = dataSheet.Cells(dataSheet.Rows.Count, columnRange.Column).End(xlUp).Row
            For Each cell In dataSheet.Range(columnRange.Cells(startRow), columnRange.Cells(lastRow))
               If Not IsEmpty(cell) And Not IsError(cell.Value) Then
                  If InStr(1, cell.Value, "Priority") = 0 Then
                     summarySheet.Cells(summaryRow, columnRange.Column).Value = cell.Value
                     summaryRow = summaryRow + 1
                  End If
               End If
            Next cell
         Next columnRange
      End If
   Next dataSheet
  
   summarySheet.Range("B:ZZ").EntireColumn.AutoFit
End Sub

[AliGW]

I think by now you should be able to come up with more informative thread titles: your title should explain what you are trying to do, not what's not working.

[NewBee_HS]

Hi AliGW,

Is this better :-)

[AliGW]

Yes, thank you.

[nankw83]

Hi NewBee_HS,

Try below code ...

Sub test()

Dim ws As Worksheet, sh As Worksheet, Lr As Long
Set sh = Sheets("Summary")

sh.[A12].Resize(sh.UsedRange.Rows.Count, 28).Clear
For Each ws In Sheets
   If ws.Name <> sh.Name Then
      For x = 2 To 26
         Lr = ws.Cells(Rows.Count, x).End(3).Row
         If Lr > 11 Then
            sh.Cells(Rows.Count, x).End(3)(2).Resize(Lr - 11) = Range(ws.Cells(12, x), ws.Cells(Lr, x)).Value
         End If
      Next
   End If
Next

End Sub

[NewBee_HS]

Hi nankw83,

This works like a charm. Thank you very much for your time and effort!
Highly appreciated. :-)

Adding rep and closing my request.