运行时错误1004方法对象全局失败的范围

时间:2016-10-14 14:35:21

标签: vba

您好我需要帮助我在代码的这一行中的代码中出现错误

Range(copyRngStart & copyRngEnd).Copy Destination:=Worksheets("Display").Range("A" & lr2 + 1)

运行时错误1004对象全局失败的方法范围

有人可以帮我看看,谢谢。

Sub Distinct()

    Dim lr2 As Long
    Dim searchRng As Range, copyRngStart As Range, copyRngEnd As Range

    Set searchRng = Worksheets("Information").Range("A1")
    lr2 = Sheets("Display").Cells(Rows.Count, "A").End(xlUp).Row

    ' Enter/continue loop while A-column is non-empty
    Do While searchRng.Value <> ""

        ' When we encounter the string TRNS in column A and Triumph Foods LLC in column E
        If searchRng.Value = "TRNS" And searchRng.Offset(0, 4).Value = "Triumph Foods LLC" Then

            ' Set the start of the copy area
            Set copyRngStart = searchRng
        End If

        ' When we encounter the string ENDTRNS
        If searchRng.Value = "ENDTRNS" Then
            ' .. set the end of the copy area
            Set copyRngEnd = searchRng.Offset(-1, 5)

            ' Copy and paste
            Range(copyRngStart & copyRngEnd).Copy Destination:=Worksheets("Display").Range("A" & lr2 + 1)
            lr2 = Sheets("Display").Cells(Rows.Count, "A").End(xlUp).Row
        End If

        ' Increment search loop
        Set searchRng = searchRng.Offset(1, 0)
    Loop
End Sub

1 个答案:

答案 0 :(得分:0)

Sub Distinct()

    Const TRNS_START As String = "TRNS"
    Const TRNS_END As String = "ENDTRNS"
    Const COMPANY As String = "Triumph Foods LLC"

    Dim searchRng As Range, copyRngStart As Range, copyRngEnd As Range

    Set searchRng = Worksheets("Information").Range("A1")

    ' Enter/continue loop while A-column is non-empty
    Do While searchRng.Value <> ""

        ' When we encounter the string TRNS in column A and Triumph Foods LLC in column E
        If searchRng.Value = TRNS_START And _
           searchRng.Offset(0, 4).Value = COMPANY Then

            Set copyRngStart = searchRng ' Set the start of the copy area
        End If

        ' When we encounter the string ENDTRNS
        '    (*and had a start cell already*)
        If searchRng.Value = TRNS_END And Not copyRngStart Is Nothing Then

            Set copyRngEnd = searchRng.Offset(-1, 5)

            copyRngEnd.Worksheet.Range(copyRngStart, copyRngEnd).Copy _
              Destination:=Sheets("Display").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

            Set copyRngStart = Nothing 'clear the "start" range

        End If


        Set searchRng = searchRng.Offset(1, 0)
    Loop
End Sub