Copy worksheets that contain more than X rows of data to another workbook

Question

I have 100 worksheets within one workbook (A). I would like to copy worksheets that contain more than 35 rows of data into workbook (B).

The code I wrote copies worksheets that have less than 35 rows of data.

Sub Split_workbook()

Dim last_row as long  
Dim sh as worksheet   
For Each sh In Worksheets   
    last_row = cells(rows.count,"A").End(xlUp).Row    
    If last_row >= 35 Then   
        sh.Copy after:=workbooks("B.xlsx").Sheets(Workbooks("B.xlsx").Sheets.count)   
    End if   
    Workbooks("A.xlsx").activate  
Next sh

End Sub

Answer 1

Copy Worksheets

• Running the code from one workbook (ThisWorkbook), copies certain worksheets from another open workbook (A.xlsx) to yet another (a third) open workbook (B.xlsx).

The Code

Option Explicit

Sub splitWorkbook()
    
    Const ProcName As String = "splitWorkbook"
    On Error GoTo clearError
    
    Const srLimit As Long = 35
    
    Dim swb As Workbook: Set swb = Workbooks("A.xlsx")
    Dim srCount As Long: srCount = swb.Worksheets(1).Rows.Count
    
    Dim dwb As Workbook: Set dwb = Workbooks("B.xlsx")
     
    Dim sws As Worksheet
    Dim sLastRow As Long
    Dim dCount As Long
    
    Application.ScreenUpdating = False
    
    For Each sws In swb.Worksheets
        sLastRow = sws.Cells(srCount, "A").End(xlUp).Row
        If sLastRow >= srLimit Then
            dCount = dCount + 1
            sws.Copy After:=dwb.Sheets(dwb.Sheets.Count)
        End If
    Next sws
    'swb.Close False
    'dwb.Close True
    
ProcExit:
    
    If Not Application.ScreenUpdating Then
        Application.ScreenUpdating = True
    End If
    
    Select Case dCount
    Case 0
        MsgBox "No worksheets copied.", vbExclamation, "Fail?"
    Case 1
        MsgBox "Copied 1 worksheet.", vbInformation, "Success"
    Case Else
        MsgBox "Copied " & dCount & " worksheets.", vbInformation, "Success"
    End Select
    
    Exit Sub

clearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "        " & Err.Description
    Resume ProcExit
End Sub