vba Excel粘贴值：自动：错误1004手动：确定

Question

strange problem: I read some Values from a sheet with a loop and paste them to another sheet.

I have a Control Module which calls one module after the other one.

My Problem: If I do the Call via control Module I run into the runtime error 1004.

When I start the macro manually it is no problem and everythin works fine..

This is my code:

    [...]
rngname = 3
    temp = 1
    Do Until Cells(lngRow, 1).Value = "test"

        lngLastRowOfSection = Cells(lngRow, 1).End(xlDown).Row

        Set slcFind = Range(Cells(lngRow, 1), Cells(lngLastRowOfSection, 1))
        slcFind.Copy
        Set targetRange = Worksheets("Node Canister VPD").Cells(1, 1)

         targetRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True


        lngRow = Cells(lngLastRowOfSection, 1).End(xlDown).Row
        If lngRow >= Rows.Count Then Exit Do

    Loop

    lngRow = 1

    rngname = 3
    i = 2
    Do Until Cells(lngRow, 1).Value = "test"

        lngLastRowOfSection = Cells(lngRow, 1).End(xlDown).Row

        Set slcFind = Range(Cells(lngRow, 2), Cells(lngLastRowOfSection, 2))
        slcFind.Copy
        Set targetRange = Worksheets("Node Canister VPD").Cells(i, 1)

         targetRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True


        lngRow = Cells(lngLastRowOfSection, 1).End(xlDown).Row
        If lngRow >= Rows.Count Then Exit Do
    i = i + 1
    Loop

[...]

Has anyone an idea? This part of the code is marked:

targetRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Best Regards, Kalain

Answer 1

Scott Holtzman is correct, define your worksheet when setting ranges. I was able to recreate the bug by having 1 sheet with valid data, the sheet to paste and another entirely blank sheet. When I ran the macro from the valid sheet, it was fine, when I ran it with the blank sheet activated it tries to transpose a blank column to a row. Excel sheets have more columns then rows, so it crashes because it can't fit.

Try using this, change "First" to whatever your source sheet is called.

Sub test()

Dim Other As New Worksheet
Set Other = Worksheets("First")
lngrow = 1
rngname = 3
    temp = 1
    Do Until other.Cells(lngrow, 1).Value = "test"

        lngLastRowOfSection = Other.Cells(lngrow, 1).End(xlDown).Row

        Set slcFind = Range(Other.Cells(lngrow, 1), Other.Cells(lngLastRowOfSection, 1))
        slcFind.Copy
        Set targetRange = Worksheets("Node Canister VPD").Cells(1, 1)

         targetRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True


        lngrow = Other.Cells(lngLastRowOfSection, 1).End(xlDown).Row
        If lngrow >= Rows.Count Then Exit Do

    Loop

    lngrow = 1

    rngname = 3
    i = 2
    Do Until Other.Cells(lngrow, 1).Value = "test"

        lngLastRowOfSection = Other.Cells(lngrow, 1).End(xlDown).Row

        Set slcFind = Range(Other.Cells(lngrow, 2), Other.Cells(lngLastRowOfSection, 2))
        slcFind.Copy
        Set targetRange = Worksheets("Node Canister VPD").Cells(i, 1)

         targetRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True


        lngrow = Other.Cells(lngLastRowOfSection, 1).End(xlDown).Row
        If lngrow >= Rows.Count Then Exit Do
    i = i + 1
    Loop

End Sub