简体   繁体   中英

excel vba range copy from one sheet to another (error 1004)

I know there are a lot of topics related to the the error 1004 (object or app error) when you try to copy paste range from one sheet to another, but I do not understand something (I am still a beginner with VBA).

I have a Excel file with 2 sheets :

  • "Worksheet1" with the data I want to copy
  • "Feuil1" where I want to paste data with a specific layout

To understand my problem, take a look at my code

    Dim a As Integer
    Dim b As Integer
    Dim val4 as integer

    val4 = 4 
    a = 2
    b = 1

    For i = 1 To val4

        Worksheets("Worksheet1").Range(Worksheets("Worksheet1").Cells(a, 1), Cells(a + 2999, 1)).Copy Destination:=Worksheets("Feuil1").Range(Worksheets("Feuil1").Cells(2, b), Cells(a + 2999, b))

        a = a + 3000
        b = b + 1

    Next i

Note : in the full code, val4 was already used before this part.

When I try to run it, I obtain error 1004 (object or app error). From what I have read, I believe the problem comes from "Cells" property where the working sheet must be specified (unlike range) but I do not understand why my code failed for copying.

Could someone explain it to me?

Can you swop as below and fully qualify sheet references as this was causing issue

Option Explicit

Sub test()

    Dim a As Long
    Dim b As Long
    Dim val4 As Long

    val4 = 4
    a = 2
    b = 1

    Dim i As Long

    For i = 1 To val4

        With Worksheets("Worksheet1")
            Worksheets("Feuil1").Range(Worksheets("Feuil1").Cells(2, b), Worksheets("Feuil1").Cells(a + 2999, b)) = .Range(.Cells(a, 1), .Cells(a + 2999, 1))
        End With
        a = a + 3000
        b = b + 1

    Next i

End Sub

You are only specifying one of the parent worksheet references to the Cells that define Range. I'd suggest a With .... End With block and you only require the top-left cell for the destination to a Copy.

with Worksheets("Worksheet1")
    For i = 1 To val4
        .Range(.Cells(a, 1), .Cells(a + 2999, 1)).Copy _
            Destination:=Worksheets("Feuil1").Cells(2, b)
        a = a + 3000
        b = b + 1
    Next i
end with

Try this one:

Dim a As Integer
Dim b As Integer
Dim val4 As Integer

val4 = 4
a = 2
b = 1

For i = 1 To val4

    Worksheets("Worksheet1").Range(Cells(a, 1), Cells(a + 2999, 1)).Copy Worksheets("Feuil1").Cells(2, b)

    a = a + 3000
    b = b + 1

Next i
Option Explicit

Sub test()
  Dim a As Integer
  Dim b As Integer
  Dim i As Integer
  Dim val4 As Integer

  val4 = 4
  a = 2
  b = 1

  For i = 1 To val4
    WorkSheet1.Range(WorkSheet1.Cells(a, 1), WorkSheet1.Cells(a + 2999, 1)).Copy Feuil1.Range(Feuil1.Cells(2, b), Feuil1.Cells(a + 2999, b))
    a = a + 3000
    b = b + 1
  Next i
End Sub

You were on the right rack with what you said about the Cells bit messing it up. The range(cells.....) must have the internal cells bit properly referenced. So each use of the word cells should be changed to worksheets(enter worksheet name in here).cells and then it will work. The solution I've posted above is slightly neater I think due to it not using the tab labels that users can change. So in the VBA editor in the properties window you can give the sheet object a name. I've called the first sheet worksheet1 and the second Feuil1 (Note ..this is not the tab name) now you can reference these objects directly in your code as I've shown above. It should all work...

you may want to speed it up by pasting values only instead of ranges

Sub test()
    Const chunksLength = 3000 ' define here your "chunks" length

    Dim i As Long
    With Worksheets("Feuil1").UsedRange.Columns(1)
        For i = 1 To .Rows.Count \ chunksLength + IIf(.Rows.Count Mod chunksLength > 0, 1, 0)
            .Offset(, i).Resize(chunksLength).Value = .Resize(chunksLength).Offset((i - 1) * chunksLength).Value
        Next
    End With
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM