VBA需求调整：将数据复制至汇总表并在每行旁插入工作表名

Hey there, let's adjust your VBA macro to handle those two worksheets that don't have data in Column B. The key is to add a check for whether Column B has valid data before trying to copy it, or even target those specific sheets directly if you know their names. Here are two solid solutions:

Option 1: Check for Column B Data Dynamically #

This version automatically detects if a worksheet has data in Column B (beyond the header) and adjusts the copy process accordingly:

Sub CopyToSummaryWithDynamicCheck()
    Dim ws As Worksheet
    Dim summaryWs As Worksheet
    Dim lastRowA As Long
    Dim lastRowB As Long
    Dim summaryLastRow As Long
    
    ' Set reference to your Summary sheet
    Set summaryWs = ThisWorkbook.Worksheets("Summary")
    
    ' Optional: Clear existing data in Summary (remove if you want to append)
    summaryWs.Range("A:C").ClearContents
    
    ' Loop through every worksheet in the workbook
    For Each ws In ThisWorkbook.Worksheets
        ' Skip the Summary sheet itself
        If ws.Name <> "Summary" Then
            ' Get last row with data in Column A (we know this exists for all sheets)
            lastRowA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            
            ' Only proceed if there's data below the header (assuming row 1 is header)
            If lastRowA >= 2 Then
                summaryLastRow = summaryWs.Cells(summaryWs.Rows.Count, "B").End(xlUp).Row + 1
                
                ' Copy Column A from source to Column B in Summary
                ws.Range("A2:A" & lastRowA).Copy summaryWs.Range("B" & summaryLastRow)
                
                ' Check if Column B has data beyond the header
                lastRowB = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
                If lastRowB >= 2 Then
                    ' Copy Column B if data exists
                    ws.Range("B2:B" & lastRowA).Copy summaryWs.Range("C" & summaryLastRow)
                Else
                    ' Leave Column C blank for these rows if no B column data
                    summaryWs.Range("C" & summaryLastRow & ":C" & summaryLastRow + lastRowA - 2).Value = ""
                End If
                
                ' Fill the source worksheet name in Column A of Summary
                summaryWs.Range("A" & summaryLastRow & ":A" & summaryLastRow + lastRowA - 2).Value = ws.Name
            End If
        End If
    Next ws
End Sub

Key Details: #

• Dynamic Check: The lastRowB variable checks if Column B has any data below your header row (adjust the >=2 to >=1 if you don't use headers).
• Avoid Empty Copies: The If lastRowA >=2 check prevents trying to copy empty rows if a sheet only has a header.
• Clean Fallback: If no B column data exists, we explicitly set Column C to empty strings instead of leaving errors or unpopulated ranges.

Option 2: Target Specific Worksheets (If You Know Their Names) #

If you already know exactly which two worksheets lack Column B data, you can skip the dynamic check and directly handle those sheets. This is more efficient if your sheet names don't change:

Sub CopyToSummaryWithSpecificSheetCheck()
    Dim ws As Worksheet
    Dim summaryWs As Worksheet
    Dim lastRowA As Long
    Dim summaryLastRow As Long
    
    Set summaryWs = ThisWorkbook.Worksheets("Summary")
    summaryWs.Range("A:C").ClearContents ' Optional: Clear existing data
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Summary" Then
            lastRowA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            
            If lastRowA >= 2 Then
                summaryLastRow = summaryWs.Cells(summaryWs.Rows.Count, "B").End(xlUp).Row + 1
                
                ' Copy Column A to Summary Column B
                ws.Range("A2:A" & lastRowA).Copy summaryWs.Range("B" & summaryLastRow)
                
                ' Check if this is one of the sheets without Column B data
                If ws.Name = "SheetNoB1" Or ws.Name = "SheetNoB2" Then
                    ' Leave Column C blank
                    summaryWs.Range("C" & summaryLastRow & ":C" & summaryLastRow + lastRowA - 2).Value = ""
                Else
                    ' Copy Column B for all other sheets
                    ws.Range("B2:B" & lastRowA).Copy summaryWs.Range("C" & summaryLastRow)
                End If
                
                ' Fill sheet name in Summary Column A
                summaryWs.Range("A" & summaryLastRow & ":A" & summaryLastRow + lastRowA - 2).Value = ws.Name
            End If
        End If
    Next ws
End Sub

Just replace SheetNoB1 and SheetNoB2 with the actual names of your two missing-data worksheets.

Both versions will ensure your Summary sheet has the correct data from all sheets, with Column C properly handled for those sheets without B column data.

内容的提问来源于stack exchange，提问作者TurboCoder