0

一部のオブジェクトをコピーしようとすると、「アプリケーション定義またはオブジェクト定義」エラーが発生します。

以前は、特定の範囲の .select と .copy を作成してから、範囲をコピーしたい場所に .paste を実行していました。これはうまくいきましたが、値を渡して .copy .paste メソッドを避けたいと思います。

そのため、コードにいくつかの変更を加えていますが、「アプリケーション定義またはオブジェクト定義」エラーを解消できません。

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)) 

CopyValues メソッドは次のとおりです。

Sub CopyValues(rngSource As Range, rngTarget As Range)

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

End Sub

コードの一部ではオブジェクトの選択がうまくいき、他の部分ではうまくいかないため、エラーがどこにあるのかわかりません。(コードが機能する場所と機能しない場所をコメントでマークしました)

前もって感謝します、

アンドレ

4

1 に答える 1