Pinlop
Pinlop

Reputation: 245

Run-time Error '1004' while pasting

I've been looking around to find out why this is giving me a Run-time error '1004' You can't paste this here because the Copy area and paste area aren't the same size. Select just one cell in the paste area or an area that's the same size, and try pasting again. but I've had no luck with the solutions I've found.

The problem here happens only on this line: ws.Columns(1).Copy Destination:=ws2.Columns(1).Rows(5)

The paste content should be just a few cells vertically i.e. "B1:B5". I can't do Range("B1:B5") because I need to have it constantly update depending on a couple of things.

Any ideas as to why I'm getting the error?

Option Explicit

Sub chkPercent()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim ws2 As Worksheet
    Dim rng As Range
    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets(1)
    Set rng = ws.Range("A1")
    Dim iq_Array As Variant
    Dim colNumb As Long
    Dim rowNumb As Long

    Application.ScreenUpdating = False

    colNumb = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    rowNumb = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    Dim iQRef() As String
    Dim iCol As Long
    Dim pptText As String

    ReDim iQRef(colNumb)
    ' capture IQ refs locally
    For iCol = 2 To colNumb
        iQRef(iCol) = ws.Cells(1, iCol).Value
    Next iCol

    Worksheets.Add After:=ws
    Set ws2 = wb.Worksheets(2)

        pptText = "iq_1,2,3,4"

        'Identify if within text there is "iq_"
        'If InStr(1, pptText, "iq_") <= 0 Then GoTo nextShpe

        'set iq_Array as an array of the split iq's
        iq_Array = Split(pptText, ",")

        Dim hasIQs As Boolean
        Dim checkStr As String
        Dim pCol As Long
        Dim checkOne
        Dim arrayLoop As Long

        checkOne = iq_Array(0)

        hasIQs = Left(checkOne, 3) = "iq_"

        If hasIQs Then
            ' paste inital column into temporary worksheet
            ws.Columns(1).Copy Destination:=ws2.Columns(1)
        End If

        ' loop for each iq_ in the array
        For arrayLoop = LBound(iq_Array) To UBound(iq_Array)
            ' Take copy of potential ref and adjust to standard if required
            checkStr = iq_Array(arrayLoop)
            If hasIQs And Left(checkStr, 3) <> "iq_" Then checkStr = "iq_" & checkStr

            Dim iQRefArray As Variant
            Dim iQRefString As String
            Dim checkRefStr As String
            Dim nCol As Long
            Dim doUntilCheck As String
            Dim rowCount As Long
            Dim copy1
            Dim paste1
            doUntilCheck = 99
            ' Look for existence of corresponding column in local copy array
            pCol = 0
            For iCol = 2 To colNumb

                iQRefString = Left(iQRef(iCol), Len(iQRef(iCol)) - 1)
                iQRefArray = Replace(iQRefString, "__", "_")
                iQRefArray = Split(iQRefArray, "_")
                checkRefStr = "iq_" & iQRefArray(1)

                If checkStr = checkRefStr Then
                    pCol = iCol
                    Exit For
                End If
            Next iCol

            If pCol > 0 Then

                ' Paste the corresponding column into the forming table
                ws.Columns(pCol).Copy Destination:=ws2.Columns(2)

                If iQRefArray(2) = "00" Then GoTo nxtArrayLoop

                nCol = 0

                rowCount = 1

                Do Until doUntilCheck = "00"
                    Do Until doUntilCheck = "01"

                    nCol = nCol + 1

                    rowCount = rowCount + rowNumb

                    iQRefString = Left(iQRef(iCol + nCol), Len(iQRef(iCol + nCol)) - 1)
                    iQRefArray = Replace(iQRefString, "__", "_")
                    iQRefArray = Split(iQRefArray, "_")

                    doUntilCheck = iQRefArray(2)
                    If doUntilCheck = "00" Then GoTo nxtArrayLoop
                    If doUntilCheck = "01" Then GoTo nxtArrayLoop

                    ws.Columns(1).Copy Destination:=ws2.Columns(1).Rows(rowCount)
                    ws.Columns(pCol + nCol).Copy Destination:=ws2.Columns(2).Rows(rowCount)
                    Loop
                Loop
            End If

nxtArrayLoop:

        Next arrayLoop


    Application.ScreenUpdating = True

End Sub

Upvotes: 1

Views: 6375

Answers (1)

Scott Holtzman
Scott Holtzman

Reputation: 27239

The error is just as it says it is. The copy and paste ranges are two different sizes.

The code tries to copy an entire column (ws.Columns(1).Copy) into a defined range (Destination:=ws2.Columns(1).Rows(5) - which I think is one cell, but I have never used that type of syntax before).

If you need to define the copy range to be dynamic than do this:

ws.Range(ws.Cells(ws.Rows.Count,1).End(Xlup),ws.Cells(1,1)).Copy Destination:=ws2.Cells(1,1)

This assumes contiguous cells starting in row 1 of column A in ws.

Upvotes: 1

Related Questions