copy and paste using if isempty not working as expected - VBA

Question

I need help with the below VBA I am trying to run.

I have multiple sheets that may or may not have data in it. They will always have headings in row 1, but may not always have data from row 2 onwards.

What I am trying to do is to look through these sheets and if there is data in there, copy it to a combined sheet.

The below finds the first sheet that has data in row 2 and copies it as expected, but then the macro finishes without looking in all the other sheets and I don't know why?

Any help much appreciated or if you have further questions about what I am doing in case it's not completely understandable!

For Each ws In ActiveWorkbook.Worksheets

    Select Case ws.Name
        Case "Setup", "Combined", "Summary", "Drop Down Menus"
        'do nothing
        
        Case Else
            Set wsDestination = ThisWorkbook.Worksheets("Combined")
                If IsEmpty(Range("A2").Value) Then
                    'find the last row
                    lrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
                        With wsDestination
                            ws.Range("A2:L" & lrow).Copy Destination:=.Range("A" & .Rows.Count).End(xlUp).Offset(1)
                        End With
                End If
    End Select
Next

You really need to specify a parent worksheet for `Range("A2").Value`. — BigBen, May 17 '23 at 15:41
@BigBen - thanks for the comment....as the macro will be looking at all sheets not names Setup, Combined, Summary or Drop Down Menus then how should I name it? — PeterK, May 17 '23 at 15:50
that doesn't include any data....I noticed that I forgot to mention that the sheets that I am trying to copy from are tables. I'm not sure if that makes a difference or not? — PeterK, May 17 '23 at 16:13
[Find the last row in a table](https://stackoverflow.com/questions/43631926/lastrow-and-excel-table). — BigBen, May 17 '23 at 16:15
when I say table, it is an SQL query that produces as a table on each sheet FYI — PeterK, May 17 '23 at 16:19
`If Not IsEmpty(ws.Range("A2").Value) Then` is the answer, so obvious.....thanks @BigBen for all your helpful comments!! — PeterK, May 18 '23 at 14:24

VBasic2008 · Answer 1 · 2023-05-18T08:50:28.153

Copy Non-Blank Rows

Option Explicit

Sub CopyNonBlankRows()
    
    ' Define constants.
    
    Const SRC_FIRST_ROW As String = "A2:L2"
    
    Const DST_SHEET As String = "Combined"
    Const DST_FIRST_CELL As String = "A2"
    
    Dim Exclusions():
    Exclusions = Array("Setup", "Combined", "Summary", "Drop Down Menus")

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the first destination row.
    
    Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET)
    Dim cCount As Long: cCount = dws.Range(SRC_FIRST_ROW).Columns.Count
    Dim dfrrg As Range:
    Set dfrrg = dws.Range(DST_FIRST_CELL).Resize(, cCount)
    
    ' Declare additional variables needed in the For...Next loop.
    
    Dim sws As Worksheet, srg As Range, slCell As Range
    Dim Data(), srCount As Long, sr As Long, dr As Long, c As Long

    ' Copy values of non-blank rows.

    ' Loop through all worksheets...
    For Each sws In wb.Worksheets
        ' Check if the source worksheet name is not in 'Exclusions'.
        If IsError(Application.Match(sws.Name, Exclusions, 0)) Then
            ' Clear filters to ensure the 'Find' method will not fail.
            If sws.FilterMode Then sws.ShowAllData
            ' Attempt to write the values to an array.
            With sws.Range(SRC_FIRST_ROW)
                ' Attempt to reference the last cell of the source range.
                Set slCell = .Resize(sws.Rows.Count - .Row + 1) _
                    .Find("*", , xlValues, , xlByRows, xlPrevious)
                If Not slCell Is Nothing Then ' the source range is not blank
                    srCount = slCell.Row - .Row + 1
                    ' Write the values to an array.
                    Data = .Resize(srCount).Value
                'Else ' the source range is blank; do nothing
                End If
            End With
            If srCount > 0 Then ' the source range is not blank
                ' Write the non-blank rows to the top of the array.
                For sr = 1 To srCount
                    For c = 1 To cCount
                        If Len(CStr(Data(sr, c))) > 0 Then
                            Exit For
                        End If
                    Next c
                    If c <= cCount Then
                        dr = dr + 1
                        For c = 1 To cCount
                            Data(dr, c) = Data(sr, c)
                        Next c
                    End If
                Next sr
                ' Write the values from the top of the array
                ' to the destination worksheet.
                dfrrg.Resize(dr).Value = Data
                ' Reset for the next iteration.
                Set dfrrg = dfrrg.Offset(dr)
                dr = 0
                srCount = 0
            'Else ' the source range is blank; do nothing
            End If
        'Else ' it's a worksheet to be excluded; do nothing
        End If
    Next sws
    
    ' Clear previous data (if any) below the result.
    
    dfrrg.Resize(dws.Rows.Count - dfrrg.Row + 1).Clear
    
    ' Inform.
     
    MsgBox "Non-blank rows copied.", vbInformation

End Sub

copy and paste using if isempty not working as expected - VBA

1 Answers1

Copy Non-Blank Rows