在工作表之间传输单元格值 | Str Looper

Question

预期结果

• 如果表中的一行包含 Sheet1 的 L 列中列出的任何字符串，则从 Sheet1 复制整行并将该行粘贴到 Sheet2 上的重复表中（开头为空白）。 （不感兴趣、不相关、未决定等...）
• 然后删除从工作表 1 转移的整行。
• 宏运行后，新传输不应重置 Sheet2 上的表，而是在预先存在的行上添加行。该文件将在数月内使用。

变量

• Sheet1 被命名为 Pipeline_Input
• Sheet2 被命名为 Closed_Sheet
• Sheet1 表名为 tblData
• Sheet2 表名为 tblClosed

图片

• 图 1 是有错误的代码
• 图 2 是表 1，带有一些图片说明
• 图 3 是表 2，带有一些图片说明

当前结果 运行时错误“1004”： 应用程序定义或对象定义的错误

Sub closedsheet()

Application.ScreenUpdating = False

    Dim Pipeline_input As Worksheet 'where is the data copied from
    Dim Closed_Sheet As Worksheet 'where is the data pasted to
    Dim strPhase() As String
    Dim i As Integer
    Dim intPhaseMax As Integer
    Dim lngLstRow As Long
    Dim rngCell As Range
    Dim finalrow As Integer
    Dim lr As Long 'row counter
    Dim Looper As Integer

    intPhaseMax = 6
    ReDim strPhase(1 To intPhaseMax)

    strPhase(1) = "LOST"
    strPhase(2) = "BAD"
    strPhase(3) = "UNINTERESTED"
    strPhase(4) = "UNRELATED"
    strPhase(5) = "UNDECIDED"
    strPhase(6) = "BUDGET"

    'set variables
    Set Pipeline_input = Sheet1
    Set Closed_Sheet = Sheet2

lr = Range("A" & Rows.Count).End(xlUp).Row

For Looper = LBound(strPhase) To UBound(strPhase)

    For i = lr To 6 Step -1
    Next
        If Not Sheet1.Range("L9:L300" & lngLstRow).Find(strPhase(Looper), lookat:=xlWhole) Is Nothing Then
        Range(Cells(i, 1), Cells(i, 20)).Copy
        Sheet2.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
        Range(Cells(i, 1), Cells(i, 20)).Delete
    End If
Next

Sheet2.Select
Sheet2.columns.AutoFit
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Answer 1

好的，您发布的代码存在大量问题，但我决定在这里为您提供帮助 - 请注意一些事项 - 这里没有复制和粘贴 - 我们只是在传输数据。

其次，使用易于理解的变量。 lr 和 lngLastRow 无法相互区分，因此请按照您从哪个工作表中获取该值对它们进行分类。

我们在这里一举创建了一个数组 - 只需声明一个变体并将我们的值放入其中。数组（通常）从零开始，而不是一，所以我们的循环从 0 开始:)。同样，这就是所谓的最佳实践...

我将Looper 换成了j。再次，保持。它。简单！

编辑：我在模拟工作簿上测试了这段代码，它运行良好 - 对你来说也不应该遇到任何问题。

EDIT2：另外，请始终使用Option Explicit！

Option Explicit
Sub closedsheet()
Application.ScreenUpdating = False

Dim Pipeline_Input As Worksheet 'source sheet
Dim Closed_Sheet As Worksheet 'destination sheet

Dim i As Long, j As Long, CSlastrow As Long, PIlastrow As Long

Dim strPhase As Variant

'Here we create our array
strPhase = Array("LOST", "BAD", "UNINTERESTED", "UNRELATED", "UNDECIDED", "BUDGET")

'Assign worksheets
Set Pipeline_Input = ActiveWorkbook.Worksheets("Pipeline_Input")
Set Closed_Sheet = ActiveWorkbook.Worksheets("Closed_Sheet")

PIlastrow = Pipeline_Input.Range("A" & Rows.Count).End(xlUp).Row

For j = 0 To UBound(strPhase)
    For i = PIlastrow To 6 Step -1
        If Pipeline_Input.Range("L" & i).Value = strPhase(j) Then

            'Refresh lastrow value
            CSlastrow = Closed_Sheet.Range("A" & Rows.Count).End(xlUp).Row

            'Transfer data
            Closed_Sheet.Range("A" & CSlastrow + 1 & ":S" & CSlastrow + 1).Value = _
            Pipeline_Input.Range("A" & i & ":S" & i).Value

            'Delete the line
            Pipeline_Input.Range("A" & i & ":S" & i).EntireRow.Delete

        End If
    Next i
Next j

Closed_Sheet.Select
Closed_Sheet.Columns.AutoFit
Application.ScreenUpdating = True
End Sub