Error when copy paste on excel using objects

Question

im getting an "application-define or object-define" error when i try to copy some objects.

I used to make a .select and .copy of certain range and then do a .paste in the place I wanted to copy the range. Althouht this worked well, i would like to just pass the value and avoid the .copy .paste method.

So, i'm making a few changes on the code and i cannot eliminate the "application-define or object-define" error.

Sub PreencherFacturador()

Application.Calculation = xlManual

Dim ano, mes1, mes2, mes3, dia, provisorio, iniciomes, maxreativa, capacitiva As Double
Dim LastRow As Long
Dim CPE, nome1, nome2, strFile, DIRECT As String
Dim data As Date
Dim Rng As Range
Dim ptTable As PivotTable
Dim pi As PivotItem
Dim ecer As Object
Dim sgl As Object

' Preencher facturador

CPE = Sheets("Dados").Cells(15, 3).Value
numproposta = Sheets("Dados").Cells(4, 3).Value
cliente = Sheets("Dados").Cells(10, 3).Value
ano = Year(Sheets("Dados").Cells(4, 5).Value)
nome1 = ActiveWorkbook.Name

If CPE = "" Then
MsgBox "CPE não encontrado."
Exit Sub
End If

Set ecer = ActiveWorkbook.Sheets("Cálculos")

Application.StatusBar = "Preenchendo facturador. Por favor aguarde."
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("Cálculos").Range("G3:L35046").ClearContents

'Consumos mes Janeiro a Agosto

For mes1 = 1 To 8

ChDrive "F"
ChDir "F:\Data3\SCF\SCFfiles\Backup"
strFile = "*" & CPE & "_" & ano & "0" & mes1 + 1 & "*.sgl"

If Len(Dir(strFile)) Then
Workbooks.Open Filename:=Dir(strFile)

'Set the workbook and the sheet i want
Set sgl = ActiveWorkbook.ActiveSheet

nome2 = ActiveWorkbook.Name
If Range("A2").Value = "" Then
Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End If
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

'HERE IT WORKS FINE
sgl.Range(Cells(4, 4), Cells(LastRow - 1, 9)).Select

dia = Right(Range("B4").Value, 2)

Windows(nome1).Activate
data = dia & "-" & "0" & mes1 & "-" & ano

With Sheets("Cálculos").Range("D:D")
Set Rng = .Find(What:=data, _
        After:=.Cells(.Cells.Count), _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)

If Not Rng Is Nothing Then
        Application.GoTo Rng, True
        iniciomes = Rng.Row
End If
End With


'HERE IT DOESNT 
sgl.Range(Cells(4, 4), Cells(LastRow - 1, 9)).Select

Call CopyValues(sgl.Range(Cells(4, 4), Cells(LastRow - 1, 9)), ecer.Sheets    ("Cálculos").Cells(iniciomes, 7))

The CopyValues method is this:

Sub CopyValues(rngSource As Range, rngTarget As Range)

    rngTarget.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value

End Sub

I don't get where the error is because in one part of the code the object selection do just fine and in the othe part it doesnt. (i've marked where the code works and where it doesnt with a comment)

Thanks in advance,

André

You should avoid `Select` and `Copy` in macros... What value is `LastRow` just before the error? — Sam, Nov 08 '13 at 10:16
`'HERE IT DOESNT: sgl.Range(Cells(4, 4), Cells(LastRow - 1, 9)).Select` Your answer lies [HERE](http://stackoverflow.com/questions/19855666/error-in-selecting-range-to-copy) — Siddharth Rout, Nov 08 '13 at 10:18
@SamWard LastRow is the value of the end of the file i want to copy. It gives me the last row of the selection. — andrescpacheco, Nov 08 '13 at 11:36
@SiddharthRout i don't get what do u mean. Do u mean that i should pass the values with variables and not with values? — andrescpacheco, Nov 08 '13 at 11:37
try actually setting your sheet against your cells object `sgl.Range(sgl.Cells(4, 4), sgl.Cells(LastRow - 1, 9))` — Sam, Nov 08 '13 at 11:40
@SiddharthRout it doesnt help. Same error. I think the error lies on the windows(nome1).activate. If i activate the sgl worbook it does the proper work. But this isnt the final solution cause i need to call the function and i can't have both workbook active. — andrescpacheco, Nov 08 '13 at 12:05

score 1 · Accepted Answer · edited May 23 '17 at 12:05

I am posting this as an answer because all this won't come in the comments.

When I mentioned in the above link that you answer lies there. It actually did. In that answer there is one more link. Anyways, here it is again INTERESTING READ

Few things about your code.

Declare the objects correctly and work with them. Avoid the use of .Activate/.Select as mentioned in the link above.
Use Option Explicit at the top of the code. There are lot of variables like numproposta which are not declared.
When you declare variables/objects as Dim ano, mes1, mes2, mes3, dia, provisorio, iniciomes, maxreativa, capacitiva As Double then only the last variable will be declared as Double and the rest as Variant. If you want all of them to be declared as double then you have to declare them as Dim ano As Double, mes1 As Double, mes2 As Double, mes3 As Double, dia As Double, provisorio As Double, iniciomes As Double, maxreativa As Double, capacitiva As Double In the below code, I have left them like that. I am sure you will declare them individually and appropriately.
Be careful when you use Exit For. If you have set Application.Calculation = xlManual in the beginning and then use Exit For then remember it will not be reset.
The line Call CopyValues(sgl.Range(sgl.Cells(4, 4), sgl.Cells(LastRow - 1, 9)), ecer.Sheets("Cálculos").Cells(iniciomes, 7)) will fail if .Find doesn't return anything because iniciomes will be 0 in that case.

Try this code (UNTESTED) I simply, rearranged your code by declaring variables/objects and fully qualifying them.

Option Explicit

Sub PreencherFacturador()
    Dim thisWb As Workbook, newWb As Workbook
    Dim ecer As Worksheet, sgl As Worksheet

    Dim ano, mes1, mes2, mes3, dia, provisorio, iniciomes, maxreativa, capacitiva As Double
    Dim LastRow As Long
    Dim CPE, nome1, nome2, strFile, DIRECT As String
    Dim data As Date
    Dim Rng As Range
    Dim ptTable As PivotTable
    Dim pi As PivotItem
    Dim numproposta, cliente

    ' Preencher facturador
    Set thisWb = ThisWorkbook

    CPE = thisWb.Sheets("Dados").Cells(15, 3).Value
    numproposta = thisWb.Sheets("Dados").Cells(4, 3).Value
    cliente = thisWb.Sheets("Dados").Cells(10, 3).Value
    ano = Year(thisWb.Sheets("Dados").Cells(4, 5).Value)

    nome1 = thisWb.Name

    If CPE = "" Then
        MsgBox "CPE não encontrado."
        Exit Sub
    End If

    Application.Calculation = xlManual
    Application.StatusBar = "Preenchendo facturador. Por favor aguarde."
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set ecer = ActiveWorkbook.Sheets("Cálculos")
    ecer.Range("G3:L35046").ClearContents

    'Consumos mes Janeiro a Agosto
    For mes1 = 1 To 8
        ChDrive "F"
        ChDir "F:\Data3\SCF\SCFfiles\Backup"
        strFile = "*" & CPE & "_" & ano & "0" & mes1 + 1 & "*.sgl"

        If Len(Dir(strFile)) Then
            Set newWb = Workbooks.Open(Filename:=Dir(strFile))
            Set sgl = newWb.ActiveSheet

            nome2 = newWb.Name

            If sgl.Range("A2").Value = "" Then
                sgl.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            End If

            LastRow = sgl.Cells(sgl.Rows.Count, 1).End(xlUp).Row

            dia = Right(sgl.Range("B4").Value, 2)

            data = dia & "-" & "0" & mes1 & "-" & ano

            With ecer.Range("D:D")
                Set Rng = .Find(What:=data, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)

                If Not Rng Is Nothing Then
                        Application.GoTo Rng, True
                        iniciomes = Rng.Row
                End If
            End With

            If iniciomes <> 0 Then _
            Call CopyValues(sgl.Range(sgl.Cells(4, 4), sgl.Cells(LastRow - 1, 9)), _
            ecer.Cells(iniciomes, 7))

            '
            '~~> Rest of the code
            '
        End If
    Next

    Application.Calculation = xlAutomatic
    Application.StatusBar = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Error when copy paste on excel using objects

1 Answers1