VBA_Copy数据及数据格式_DoLoop删除空行

Sub copyreport()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.DisplayAlerts = False
    
Dim wb, wb2 As Workbook
Dim myFile As String, i As Long, lc As Long, lr As Long, lr1 As Long
If LCase(get_R1_Run_by_Robot) = "y" Then thsmn.Range("B3") = vcrparms.Cells(5, "B")
thswbk.Sheets("WD").Cells.Clear
myFile = thsmn.Range("B3").Value
If thsmn.Range("B3") <> "" Then

    Set wb = Workbooks.Open(fileName:=myFile)
    wb.Sheets("Bank Details Report").Range("A1:Z60000").Copy
    thswbk.Sheets("WD").Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
    wb.Sheets("Bank Details Report").Range("A1:Z60000").Copy
    thswbk.Sheets("WD").Range("A1").PasteSpecial xlPasteAllUsingSourceTheme
    wb.Sheets("Bank Details Report").Range("A1:Z60000").Copy
    thswbk.Sheets("WD").Range("A1").PasteSpecial xlPasteColumnWidths
    wb.Close False
    If LCase(get_R1_Run_by_Robot) = "n" Then MsgBox "Workday file has been uploaded!"
    
End If
thswbk.Sheets("Manual-Run").Activate
' Deleting the blank rows   
lr = thswbk.Sheets("WD").Cells(Rows.Count, 1).End(xlUp).Row
lr1 = thswbk.Sheets("WD").Cells(lr, 1).End(xlUp).Row - 1  '可以定位到数据区域的空行
Do Until lr1 < 1                                          '所有涉及到删除行数据的操作都不要使用 for each和for range循环，会有指针问题导致的删错行。
    thswbk.Sheets("WD").Cells(lr1, 1).EntireRow.Delete    '删除空行
    lr1 = lr1 - 1
Loop
' Adding New Formulas

i = 2
lr = thswbk.Worksheets("WD").Cells(Rows.Count, "A").End(xlUp).Row
Do Until cfgsht.Cells(i, "O") = ""
    If cfgsht.Cells(i, "O") = "WD" Then
        lc = thswbk.Sheets("WD").Cells(1, Columns.Count).End(xlToLeft).Column + 1
        thswbk.Sheets("WD").Cells(1, lc) = cfgsht.Cells(i, "R")
        thswbk.Sheets("WD").Cells(1, lc - 1).Copy
        thswbk.Sheets("WD").Cells(1, lc).PasteSpecial xlPasteFormats
        thswbk.Sheets("WD").Cells(1, lc).EntireColumn.ColumnWidth = 20
        Application.CutCopyMode = False
        thswbk.Sheets("WD").Cells(2, lc) = "=" & cfgsht.Cells(i, "Q")
        thswbk.Sheets("WD").Cells(2, lc).AutoFill thswbk.Sheets("WD").Range(thswbk.Sheets("WD").Cells(2, lc), thswbk.Sheets("WD").Cells(lr, lc))
    End If
    i = i + 1
Loop

End Sub

有用的代码 2：

https://blog.csdn.net/hpdlzu80100/article/details/80735289