如何修改VBA按钮宏，复制指定区域时跳过D列空白行

Hey there! Let's figure out how to tweak your VBA code so it copies rows from C6:D18 on the "SNOW" worksheet only when column D has non-empty text values. Since you're working with text (not numbers), we need to make sure we're checking for actual text content, not just blank cells that might have hidden spaces or numeric blanks.

Method 1: Loop Through Rows (Great for Small Ranges) #

This approach is straightforward and perfect for your small range (only 13 rows total). We'll loop through each row in D6:D18, check if the cell has non-empty text, and build a combined range of valid rows to copy.

Sub CopyNonEmptyDRows()
    Dim ws As Worksheet
    Dim checkRange As Range
    Dim currentCell As Range
    Dim validRows As Range
    
    ' Set reference to the "SNOW" worksheet
    Set ws = ThisWorkbook.Worksheets("SNOW")
    ' Define the column D range we need to check
    Set checkRange = ws.Range("D6:D18")
    
    ' Loop through each cell in column D
    For Each currentCell In checkRange
        ' Check if the cell has non-empty text (trim to ignore leading/trailing spaces)
        If Len(Trim(currentCell.Text)) > 0 Then
            ' Add the C:D columns of this row to our valid range
            If validRows Is Nothing Then
                Set validRows = ws.Range("C" & currentCell.Row & ":D" & currentCell.Row)
            Else
                Set validRows = Union(validRows, ws.Range("C" & currentCell.Row & ":D" & currentCell.Row))
            End If
        End If
    Next currentCell
    
    ' Copy the valid rows if we found any
    If Not validRows Is Nothing Then
        validRows.Copy
        ' Optional: Add a paste command here if you know where to paste, e.g.:
        ' ws.Range("F6").PasteSpecial xlPasteValues
    Else
        MsgBox "No rows with non-empty text in column D were found to copy!"
    End If
End Sub

Key Notes: #

• currentCell.Text grabs the exact text displayed in the cell, which aligns with your focus on text values.
• Trim() removes any leading/trailing spaces, so cells that only have spaces won't be counted as valid.
• Union() combines all valid rows into a single range, so you can copy them all at once.

Method 2: Use AutoFilter (Faster for Larger Ranges) #

If you ever expand your range to hundreds of rows, AutoFilter is more efficient. This method filters out rows where D is empty, then copies the visible rows.

Sub CopyNonEmptyDRowsWithFilter()
    Dim ws As Worksheet
    Dim fullRange As Range
    
    Set ws = ThisWorkbook.Worksheets("SNOW")
    ' Include a header row (C5:D5) here—adjust if your actual header is different
    Set fullRange = ws.Range("C5:D18")
    
    ' Clear any existing filters on the worksheet
    ws.AutoFilterMode = False
    
    ' Filter column D (the 2nd column in our fullRange) to show non-empty values
    fullRange.AutoFilter Field:=2, Criteria1:="<>"
    
    ' Copy the visible rows (skip the header row with Offset(1,0))
    fullRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
    
    ' Turn off the filter when done
    ws.AutoFilterMode = False
End Sub

Key Notes: #

• Make sure to include a header row in fullRange (we used C5:D5 as an example—adjust this to match your actual header if needed).
• SpecialCells(xlCellTypeVisible) targets only the rows that aren't hidden by the filter.

Either method will work for your current range. The loop method is easier to tweak if you need to add extra conditions later, while AutoFilter is better for larger datasets.

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