Objectvariabele of blokvariabele With is niet ingesteld

[HWV]

Beste,

Ik probeer de code te optimaliseren en heb de "on error resume next" eruit gehaald en de melding te laten geven waar het enigzins fout kan lopen doormiddel van "On Error GoTo Err_Knop1_Click".
Maar nu krijg ik de foutmelding Objectvariabele of blokvariabele With is niet ingesteld, en via F8 geef hij dit bij de rode tekst.

Sub InkoopFactuurKoppelen()
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

Dim Answer As String
Dim MyNote As String
 
On Error GoTo Err_Knop1_Click
'On Error Resume Next

    MyNote = "Weet je het zeker, dat je deze gegevens wil plaatsen in de DataBase?"
    Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "")
 
    If Answer = vbNo Then
        MsgBox "Er worden geen wijzigingen aangebracht"
    Else
        Sheets("I2 - Excel Totaal IF").Select
    For j = 2 To Sheets("VerkoopGegevens").Cells(Rows.Count, 1).End(xlUp).Row
        With Sheets("I2 - Excel Totaal IF").Columns(1).Find(Sheets("VerkoopGegevens").Cells(j, 1).Value)
[COLOR="#FF0000"]            .Offset(, 1).Copy Sheets("VerkoopGegevens").Cells(j, 14)[/COLOR]
            .Offset(, 1).Copy Sheets("InkoopGegevens").Cells(j, 16)
        End With
    Next
  
MsgBox ("Gegevens zijn overgezet")

    End If

Exit_Knop1_Click:
Exit Sub
Err_Knop1_Click:
MsgBox Err.Description
Resume Exit_Knop1_Click

With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

Alvast dank voor de ondersteuning.

Henk

 

[wampier]

Is het probleem niet de ".Value" aan het eind van je je WITH statement? je probeert nu een offset te doen aan de hand van de waarde in de cel?

 

[HSV]

Als onderstaande niet gevonden wordt met 'Find', geeft de offset(,1).copy de fout.

With Sheets("I2 - Excel Totaal IF").Columns(1).Find([COLOR=#ff0000]Sheets("VerkoopGegevens").Cells(j, 1).Value[/COLOR])

Beter:

set c = Sheets("I2 - Excel Totaal IF").Columns(1).Find(Sheets("VerkoopGegevens").Cells(j, 1).Value)
if not c is nothing then c.offset(,1).copy Sheets("VerkoopGegevens").Cells(j, 14)

 

[HWV]

Beste,

Dank voor de oplossing, ik heb het aangepast naar :

Sub InkoopFactuurKoppelen()
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

Dim Answer As String
Dim MyNote As String
 
    MyNote = "Weet je het zeker, dat je deze gegevens wil plaatsen in de DataBase?"
    Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "")
 
    If Answer = vbNo Then
        MsgBox "Er worden geen wijzigingen aangebracht", , ""
    Else
        Sheets("I2 - Excel Totaal IF").Select
        
    For j = 2 To Sheets("VerkoopGegevens").Cells(Rows.Count, 1).End(xlUp).Row
        Set c = Sheets("I2 - Excel Totaal IF").Columns(1).Find(Sheets("VerkoopGegevens").Cells(j, 1).Value)
            If Not c Is Nothing Then c.Offset(, 1).Copy Sheets("VerkoopGegevens").Cells(j, 14)
        Set c = Sheets("I2 - Excel Totaal IF").Columns(1).Find(Sheets("InkoopGegevens").Cells(j, 1).Value)
            If Not c Is Nothing Then c.Offset(, 1).Copy Sheets("InkoopGegevens").Cells(j, 16)
     Next
  
MsgBox ("Gegevens zijn overgezet"), , ""

    End If

With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

Hartelijk dank voor de uitleg, en ga het verder testen.:thumb:

Groet Henk