Copy a contiguous sub-column of cells This code searches for the word &quot;Disbursements&quot; and copies all of the rows with data below it, including the row with the specified word. After the rows are copied to a new sheet, the unnecessary rows below the contiguous range of data are deleted. In order to search for the last cell, I used a function that finds the last cell with data.
Instead of deleting the rows below the contiguous range, should I just copy the contiguous rows to begin with? Is there a better way to delete the rows below the first blank row?
Sub Reformat_ZZ_CM_BNREG()

Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.DisplayAlerts = False

'declare variables to search for within bank register
Dim searchText As String
Dim ws As Worksheet
Dim searchCell As Range
Dim newWS As Worksheet
Dim lastCell As String
Dim firstCell As String
Dim lastRow As Long


'set variables to sheet name, search text, and searchCell
searchText = &quot;Disbursements&quot;
Set ws = Sheets(&quot;ZZ_CM_BNREG&quot;)
lastCell = FindLast(3, &quot;ZZ_CM_BNREG&quot;)
'Set lastCell = Range(Cells.Find(&quot;*&quot;, , xlFormulas, , xlRows, xlPrevious, , , False), Cells.Find(&quot;*&quot;, , xlFormulas, , xlColumns, xlPrevious, , , False))
Set newWS = Sheets.Add(After:=Sheets(&quot;ZZ_CM_BNREG&quot;))
newWS.Name = &quot;Bank Register&quot;

'Unmerge all cells in Column A &amp; get cell address of searchCell
With ws

    ws.Activate
    
    Range(&quot;A:A&quot;).UnMerge
    
    Set searchCell = .Cells.Find(What:=&quot;Disbursements&quot;, _
        SearchFormat:=True)
    
    If searchCell Is Nothing Then
        MsgBox (&quot;Error&quot;)
    Else
        firstCell = searchCell.Address
    End If

End With

'copy range using above function to get last cell in range
'paste range onto the new sheet
'we are starting with the cell containing disbursements
ws.Range(firstCell, lastCell).Copy _
    Destination:=newWS.Range(&quot;A1&quot;)

DeleteRowsAndSheet

End Sub

Sub DeleteRowsAndSheet()

Dim LR As Long
LR = Sheets(&quot;Bank Register&quot;).Range(&quot;A1&quot;).End(xlDown).Row

Sheets(&quot;Bank Register&quot;).Activate
Rows(LR + 1 &amp; &quot;:&quot; &amp; LR + 20).Delete

Sheets(&quot;Bank Register&quot;).Range(&quot;1:1&quot;).Delete

Sheets(&quot;ZZ_CM_BNREG&quot;).Delete

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Application.DisplayAlerts = True

End Sub
I will address your code in sections and at the end I will provide a full updated code based on the touched subjects.
Application state
You are turning the Application 'off' with:

Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.DisplayAlerts = False


at the beginning of your method and then you turn it back 'on' with:

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Application.DisplayAlerts = True


at the end of another method.
It's a good idea to turn things back on within the scope of the same method. In your case you would add the latter 3 lines at the end of the Reformat_ZZ_CM_BNREG method immediately after calling the DeleteRowsAndSheet method. You should not rely on another method to 'clean-up' for you. What if you decide that you don't need to call that method in the future? There is a high chance you will forget to move the 'clean-up' code back in the main method.
How about turning things 'off' and then back 'on'. It's not a good idea to do this, even if it works for you in this situation, because in time you can get used to this kind of approach and repeat it without giving too much thought. Imagine you have another method called Main that turns the application 'off' and then calls your Reformat_ZZ_CM_BNREG method and then does other stuff like calling a method called MyMethod and then finally turns the application back 'on'. Something like:
Sub Main()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Application.DisplayAlerts = False
    
    Reformat_ZZ_CM_BNREG
    MyMethod
    
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    Application.DisplayAlerts = True
End Sub

What if MyMethod expects the calculation to be 'off'? Well, Reformat_ZZ_CM_BNREG actually turns things back 'on' and you can clearly see this is not what MyMethod (or even Main expects).
What if the Calculation needs to be Manual all the time because this is what the user of the Workbook wants?
The best approach, which you should always use, is to make no assumption of what the current state is because you have no control of what other higher-level methods might expect/do with the state. Your method should look like this:
Sub Reformat_ZZ_CM_BNREG()
    Dim appScrUpdate As Boolean
    Dim appCalc As XlCalculation
    Dim appDispAlert As Boolean

    'Store current Application state
    appScrUpdate = Application.ScreenUpdating
    appCalc = Application.Calculation
    appDispAlert = Application.DisplayAlerts
    
    'Turn state off
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Application.DisplayAlerts = False
    
    'Actual code
    '...
    '...
    '...
    

RestoreState:
    Application.ScreenUpdating = appScrUpdate
    Application.Calculation = appCalc
    Application.DisplayAlerts = appDispAlert
End Sub

RestoreState: line label can be used in case you want to early exit the method using something like GoTo RestoreState which would still do the 'clean-up'
In short, you restore the state as it was, making no assumptions, to make sure you do not impact logic somewhere else.
There is a lot of boilerplate code to do this so I use a class instead so that I can have multiple instances with stored state at any given time. Here is what I usually use, and the code above would get simplified to something like:
Sub Reformat_ZZ_CM_BNREG()
    Dim app As New ExcelAppState
    app.StoreState
    app.Sleep
    
    'Actual code
    '...
    '...
    '...
    
    app.RestoreState
End Sub

Indentation
For me, it is much easier to read this:
Function DoSomething() As Integer
    Dim iNumber As Integer
    For iNumber = 1 To 5
        DoSomething = DoSomething + iNumber
    Next iNumber
End Sub

compared to this:
Function DoSomething() As Integer
Dim iNumber As Integer
For iNumber = 1 To 5
    DoSomething = DoSomething + iNumber
Next iNumber
End Sub

especially when I have a large number of methods. Although your code is working, please consider this aesthetic aspect when writing code. All code that is within the scope of the method should have an extra indentation level than the method definition.
Hardcoding
You are using the same string literals in multiple places: &quot;Disbursements&quot;, &quot;ZZ_CM_BNREG&quot;, &quot;Bank Register&quot;. Consider declaring them as constants so that you only need to change them (if needed) in a single place:
Const searchText As String = &quot;Disbursements&quot;
Const sourceShtName As String = &quot;ZZ_CM_BNREG&quot;
Const targetShtName As String = &quot;Bank Register&quot;

If you ever decide to receive these as method parameters then all you need to do is to move the constants (without the Const keyword) into the method definition without needing other changes e.g. Sub Reformat_ZZ_CM_BNREG(ByVal searchText As String, ByVal sourceShtName As String, ByVal targetShtName). Might not be useful here, but you get the idea.
Worksheet assumptions
You are making the following assumptions:

a worksheet named &quot;ZZ_CM_BNREG&quot; exists
a worksheet named &quot;Bank Register&quot; does not exist
sheet named &quot;ZZ_CM_BNREG&quot; is a Worksheet (it could be a chart sheet)
the workbook is unprotected

Obviously, it works for you but it's better to be a bit precautious to avoid unexpected errors and behaviour. Consider this: if any of the assumptions would fail then a runtime error would be raised, and you would not get the chance to restore the application state (or do other clean-up operations that might be required).
Consider an auxiliary function to retrieve the worksheet:
Public Function GetWorksheetByName(ByVal wsName As String, ByVal book As Workbook) As Worksheet
    On Error Resume Next
    Set GetWorksheetByName = book.Worksheets(wsName)
    On Error GoTo 0
End Function

you could simply use it like this:
Set ws = GetWorksheetByName(sourceShtName, ThisWorkbook)
If ws Is Nothing Then
    'Do something e.g. show a message box if needed, restore state or exit method
    '...
End If

Notice the auxiliary function uses the Worksheets collection instead of the Sheets collection.
How about these 2 lines?

Set newWS = Sheets.Add(After:=Sheets(&quot;ZZ_CM_BNREG&quot;))
newWS.Name = &quot;Bank Register&quot;


As mentioned, these would fail if the workbook is protected or if another sheet with the same name already exists. You can guard with something like:
On Error Resume Next
Set newWs = ThisWorkbook.Worksheets.Add(After:=ws)
If Err.Number &lt;&gt; 0 Then
    MsgBox &quot;Cannot insert new worksheet&quot;, vbExclamation, &quot;Failed&quot;
    Err.Clear
    'Restore state or exit method
End If
newWs.Name = targetShtName
If Err.Number &lt;&gt; 0 Then
    MsgBox &quot;Cannot rename worksheet&quot;, vbExclamation, &quot;Failed&quot;
    'This might not be critical so just resume
End If
On Error GoTo 0

Notice that I haven't retrieved the source worksheet again, unnecessarily. Instead I simply used After:=ws
Finding desired range

In order to search for the last cell, I used a function that finds the last cell with data.

I am not sure what the 3 value does when calling the FindLast method with FindLast(3, &quot;ZZ_CM_BNREG&quot;). I suspect you are starting from the 3rd row.
The commented line Set lastCell = Range(Cells.Find(&quot;*&quot;, , xlFormulas, , xlRows, xlPrevious, , , False), Cells.Find(&quot;*&quot;, , xlFormulas, , xlColumns, xlPrevious, , , False)) returns a Range object while the variable was declared as text with Dim lastCell As String. The commented line simply does not compile if I uncomment it. It's missing a trailing .Address and the Set needs to be removed. Anyway, I assume your FindLast function returns the text address of the last row and column with data in a similar manner with the modified commented line.
You are looking for the desired text with:

'Unmerge all cells in Column A &amp; get cell address of searchCell
With ws

   ws.Activate
   
   Range(&quot;A:A&quot;).UnMerge
   
   Set searchCell = .Cells.Find(What:=&quot;Disbursements&quot;, _
       SearchFormat:=True)
   
   If searchCell Is Nothing Then
       MsgBox (&quot;Error&quot;)
   Else
       firstCell = searchCell.Address
   End If

End With


but although you are unmerging column A you are searching for your text within the whole worksheet with ws.Cells.Find(What:=&quot;Disbursements&quot;, SearchFormat:=True) (ws is implied from the With block).
Assuming there is no &quot;Disbursements&quot; value in columns A and B but there is such a value in column C then your code copies data starting with column C and lose the information in column A and B. As I am unsure if this is intended functionality or not, I made the assumption that you want all columns of data regardless where the keyword is found.

Instead of deleting the rows below the contiguous range, should I just copy the contiguous rows to begin with? Is there a better way to delete the rows below the first blank row?

Yes, it's faster to simply copy only what you need instead of copying useless data that you are going to delete anyway. Your second question suggests that you are only interested in data up to (but not including) the first blank row.
I do not know what you consider a &quot;blank row&quot; to be. I can see that you find the last row (in the target sheet) with Sheets(&quot;Bank Register&quot;).Range(&quot;A1&quot;).End(xlDown).Row but that means you are actually looking for the first blank cell in the 'A' column and you don't care if there is data in the rest of the columns. Anyway, I assumed that you are interested in actual &quot;blank rows&quot; (i.e. no data in any of the columns) not just on the 'A' column. Here is a function that can check if a row is empty for a 2D array:
Private Function Is2DArrayRowEmpty(arr() As Variant, ByVal rowIndex As Long, Optional ByVal ignoreEmptyStrings As Boolean = False) As Boolean
    Dim j As Long
    Dim v As Variant
    
    For j = LBound(arr, 2) To UBound(arr, 2)
        v = arr(rowIndex, j)
        Select Case VBA.VarType(v)
            Case VbVarType.vbEmpty
                'Continue to next element
            Case VbVarType.vbString
                If Not ignoreEmptyStrings Then Exit Function
                If v &lt;&gt; vbNullString Then Exit Function
            Case Else
                Exit Function
        End Select
    Next j
    Is2DArrayRowEmpty = True 'If code reached this line then row is Empty
End Function

Reading the worksheet's used range into an array should give us the flexibility to find the desired range faster.
It's not really needed to insert a new worksheet (and to turn the application state to 'off' and later back 'on') if we cannot find any data that we want to take across. It makes more sense to first search for the data and only then proceed with the other operations.
Final code
Code in a standard module:
Option Explicit

Sub Reformat_ZZ_CM_BNREG()
    Const searchText As String = &quot;Disbursements&quot;
    Const sourceShtName As String = &quot;ZZ_CM_BNREG&quot;
    Const targetShtName As String = &quot;Bank Register&quot;
    
    Dim sourceWS As Worksheet
    Dim targetWS As Worksheet
    
    Set sourceWS = GetWorksheetByName(sourceShtName, ThisWorkbook)
    If sourceWS Is Nothing Then
        MsgBox &quot;Missing worksheet&quot;, vbExclamation, &quot;Cancelled&quot;
        Exit Sub
    End If
    
    Dim rngUsed As Range
    
    On Error Resume Next
    Set rngUsed = sourceWS.UsedRange
    On Error GoTo 0
    If rngUsed Is Nothing Then
        MsgBox &quot;Sheet has no data&quot;, vbExclamation, &quot;Cancelled&quot;
        Exit Sub
    ElseIf rngUsed.Count = 1 Then
        MsgBox &quot;Sheet has only 1 cell of data&quot;, vbExclamation, &quot;Cancelled&quot;
        Exit Sub
    End If
    
    Dim arrData() As Variant: arrData = rngUsed.Value2
    Dim lowRowIndex As Long: lowRowIndex = LBound(arrData, 1)
    Dim uppRowIndex As Long: uppRowIndex = UBound(arrData, 1)
    Dim v As Variant
    Dim i As Long
    Dim firstRow As Long
    Dim lastRow As Long
    
    i = lowRowIndex
    For Each v In arrData 'Traverses array in column-wise order (faster than For...To)
        If VarType(v) = vbString Then
            If InStr(1, v, searchText, vbTextCompare) &gt; 0 Then
                firstRow = i + 1
                Exit For
            End If
        End If
        i = i + 1
        If i &gt; uppRowIndex Then 'Next column follows - You might want to Exit For if you are only interested in the first column
            i = lowRowIndex
        End If
    Next v
    
    If firstRow = 0 Then
        MsgBox &quot;Text not found&quot;, vbExclamation, &quot;Cancelled&quot;
        Exit Sub
    End If
    
    'Find last non-blank row
    lastRow = uppRowIndex
    For i = firstRow To uppRowIndex
        If Is2DArrayRowEmpty(arrData, i, True) Then
            lastRow = i - 1
            Exit For
        End If
    Next i
    If lastRow &lt; firstRow Then
        MsgBox &quot;No rows found after desired row&quot;, vbExclamation, &quot;Cancelled&quot;
        Exit Sub
    End If
    
    Dim app As New ExcelAppState: app.Sleep: app.StoreState

    'Prepare Target
    On Error Resume Next
    Set targetWS = ThisWorkbook.Worksheets.Add(After:=sourceWS)
    If Err.Number &lt;&gt; 0 Then
        MsgBox &quot;Cannot insert new worksheet&quot;, vbExclamation, &quot;Failed&quot;
        Err.Clear
        app.RestoreState
        Exit Sub
    End If
    targetWS.Name = targetShtName
    If Err.Number &lt;&gt; 0 Then
        MsgBox &quot;Cannot rename worksheet&quot;, vbInformation, &quot;Renaming skipped&quot;
        'This might not be critical so just continue
    End If
    On Error GoTo 0
    
    'Write data
    With rngUsed
        Range(.Cells(firstRow, 1), .Cells(lastRow, .Columns.Count)).Copy _
            Destination:=targetWS.Cells(1, 1)
    End With
    
    sourceWS.Delete
    app.RestoreState
End Sub

Public Function GetWorksheetByName(ByVal wsName As String, ByVal book As Workbook) As Worksheet
    On Error Resume Next
    Set GetWorksheetByName = book.Worksheets(wsName)
    On Error GoTo 0
End Function

Private Function Is2DArrayRowEmpty(arr() As Variant, ByVal rowIndex As Long, Optional ByVal ignoreEmptyStrings As Boolean = False) As Boolean
    Dim j As Long
    Dim v As Variant
    
    For j = LBound(arr, 2) To UBound(arr, 2)
        v = arr(rowIndex, j)
        Select Case VBA.VarType(v)
            Case VbVarType.vbEmpty
                'Continue to next element
            Case VbVarType.vbString
                If Not ignoreEmptyStrings Then Exit Function
                If v &lt;&gt; vbNullString Then Exit Function
            Case Else
                Exit Function
        End Select
    Next j
    Is2DArrayRowEmpty = True 'If code reached this line then row is Empty
End Function

and of course, a simplified version of the ExcelAppState class (that I linked to above). This one uses only the 3 application properties that you were using:
Option Explicit

Private m_calculationMode As XlCalculation
Private m_screenUpdating As Boolean
Private m_displayAlerts As Boolean

Private m_hasStoredState As Boolean
Private m_hasStoredCalcMode As Boolean

Public Sub StoreState()
    With Application
        On Error Resume Next 'In case no Workbook is opened
        m_calculationMode = .Calculation
        m_hasStoredCalcMode = (Err.Number = 0)
        On Error GoTo 0
        m_screenUpdating = .ScreenUpdating
        m_displayAlerts = .DisplayAlerts
    End With
    m_hasStoredState = True
End Sub

Public Sub RestoreState(Optional ByVal maxSecondsToWait As Integer)
    If Not m_hasStoredState Then
        Err.Raise 5, TypeName(Me) &amp; &quot;.RestoreState&quot;, &quot;State not stored&quot;
    End If
    With Application
        If m_hasStoredCalcMode Then
            On Error Resume Next
            If .Calculation &lt;&gt; m_calculationMode Then .Calculation = m_calculationMode
            On Error GoTo 0
        End If
        If .ScreenUpdating &lt;&gt; m_screenUpdating Then .ScreenUpdating = m_screenUpdating
        If .DisplayAlerts &lt;&gt; m_displayAlerts Then .DisplayAlerts = m_displayAlerts
    End With
    m_hasStoredState = False
End Sub

Public Sub Sleep()
    With Application
        On Error Resume Next
        If .Calculation &lt;&gt; xlCalculationManual Then .Calculation = xlCalculationManual
        On Error GoTo 0
        If .ScreenUpdating Then .ScreenUpdating = False
        If .DisplayAlerts Then .DisplayAlerts = False
    End With
End Sub

Public Sub Wake(Optional ByVal maxSecondsToWait As Integer = 10)
    With Application
        On Error Resume Next
        If .Calculation &lt;&gt; xlCalculationAutomatic Then .Calculation = xlCalculationAutomatic
        On Error GoTo 0
        If Not .ScreenUpdating Then .ScreenUpdating = True
        If Not .DisplayAlerts Then .DisplayAlerts = True
    End With
End Sub