excel - 如何改进删除第一个空白行以下的行的代码

Question

我有以下代码按预期工作，但我想知道是否有更好的方法来编写它。基本上，此代码搜索单词“Disbursements”并复制其下方包含数据的所有行，包括具有指定单词的行。将行复制到新工作表后，将删除连续数据范围下方的不必要行。为了搜索最后一个单元格，我使用了一个函数来查找最后一个包含数据的单元格。而不是删除连续范围以下的行，我应该只复制连续的行开始吗？有没有更好的方法来删除第一个空白行下面的行？

任何见解表示赞赏！谢谢！

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 = "Disbursements"
Set ws = Sheets("ZZ_CM_BNREG")
lastCell = FindLast(3, "ZZ_CM_BNREG")
'Set lastCell = Range(Cells.Find("*", , xlFormulas, , xlRows, xlPrevious, , , False), Cells.Find("*", , xlFormulas, , xlColumns, xlPrevious, , , False))
Set newWS = Sheets.Add(After:=Sheets("ZZ_CM_BNREG"))
newWS.Name = "Bank Register"

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

    ws.Activate
    
    Range("A:A").UnMerge
    
    Set searchCell = .Cells.Find(What:="Disbursements", _
        SearchFormat:=True)
    
    If searchCell Is Nothing Then
        MsgBox ("Error")
    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("A1")

DeleteRowsAndSheet

End Sub

Sub DeleteRowsAndSheet()

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

Sheets("Bank Register").Activate
Rows(LR + 1 & ":" & LR + 20).Delete

Sheets("Bank Register").Range("1:1").Delete

Sheets("ZZ_CM_BNREG").Delete

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

End Sub

标签： excelvba