如果在列

Question

我需要一些有关此代码的帮助。

目前，该代码应该创建一个新的工作簿（wbO），并从原始工作簿（wbI）中提取一张表，并将其作为值粘贴在其上，同时保持其格式。

这部分代码完全可以正常工作。

下一步，我需要搜索位于列E上的字符串“ Blank Interval”，并删除找到的所有实例的整行。只要数据流逝，它就应该循环播放，并且可以随时更改。

为此，我基于将表粘贴到新工作簿（wb0）之后的总行数来设置循环

这是完整的代码，任何建议或帮助将不胜感激：

   Dim wbI As Workbook, wbO As Workbook
   Dim wsI As Worksheet, wsO As Worksheet


   Set wbI = ThisWorkbook

   Set wsI = wbI.Sheets("TempUpload")


   Set wbO = Workbooks.Add

   With wbO
       Set wsO = wbO.Sheets("Sheet1")
       wsI.Range("A1:I1").Copy
       wsO.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
       SkipBlanks:=False, Transpose:=False
       wsI.Range("Tupload").Copy
       wsO.Range("A2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, _
       SkipBlanks:=False, Transpose:=False
   End With

   Set wbO = ActiveWorkbook
   Dim lRow As Long
   Dim iCntr As Long
   Dim last_row As Long
   last_row = Cells(Rows.count, 1).End(x1up).Row
   lRow = last_row
   For iCntr = lRow To 1 Step -1
   If Cells(iCntr, 5) = "Blank Interval" Then

       Rows(iCntr).Delete
   End If
Next
   ```

Answer 1

我能够通过更改数据大小的计算方式来使其工作。

这是最终代码：

子输出（）     wbO作为工作簿，wbO作为工作簿     wsI作为工作表，wsO作为工作表

Set wbI = ThisWorkbook

Set wsI = wbI.Sheets("TempUpload")


Set wbO = Workbooks.Add

With wbO
    Set wsO = wbO.Sheets("Sheet1")
    wsI.Range("A1:I1").Copy
    wsO.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    wsI.Range("Tupload").Copy
    wsO.Range("A2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
End With

Set wbO = ActiveWorkbook
Dim lRow As Long
Dim iCntr As Long
Dim last_row As Long
last_row = Range("A" & Rows.count).End(xlUp).Row

lRow = last_row
For iCntr = lRow To 1 Step -1
If Cells(iCntr, 5) = "Blank Interval" Then
           Rows(iCntr).Delete
End If

下一步