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无法相互区分，因此请根据您从中获取该值的工作表对其进行分类。

我们在这里一次创建一个数组 - 只需声明一个变量并将我们的值放入。 ARRAYS（通常）从零开始，而不是一个，所以我们的循环从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

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

1 个答案: