Run-time error 1004 "paste method of worksheet class failed"

[dannieshelp]

Hallo,

Ik gebruik de onderstaande code om data die aan een bepaalde voorwaarde voldoet vanuit een werkblad te copieren naar een archief.

Nu krijg ik telkens een runtime error 1004. Ik kom er niet uit. kan iemand mij vertellen wat ik moet doen?

De code is als volgt:

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Blad2.Unprotect
Blad5.Unprotect

With Worksheets("Formulation Active").Range("A5:A100")
Do
Set A = .Find("Complete", LookIn:=xlValues, SearchDirection:=xlNext)
If Not A Is Nothing Then
B = A.Row
Rows(B).Copy
Worksheets("Formulation Archive").Select
With Worksheets("Formulation Archive").Range("A5:A10000")
Set Z = .Find("", LookIn:=xlValues)
If Not Z Is Nothing Then
Z = Z.Row
Worksheets("Formulation Archive").Range("A" & CStr(Z)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
End With
Worksheets("Formulation Active").Select
Rows(B).Select
Selection.Delete
End If
Loop Until A Is Nothing
End With
Blad2.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True _
, AllowFiltering:=True, AllowInsertingHyperlinks:=True
Blad5.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
Application.ScreenUpdating = True

End Sub

Alvast bedankt voor de hulp.

Groeten,

Danny

 

[Relleboer]

Graag een voorbeeldbestand er bij dan kunnen we het proberen

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Blad2.Unprotect
Blad5.Unprotect

With Worksheets("Formulation Active").Range("A5:A100")
    Do
    Set A = .Find("Complete", LookIn:=xlValues, SearchDirection:=xlNext)
    If Not A Is Nothing Then
    B = A.Row
    Rows(B).Copy
    Worksheets("Formulation Archive").Select
        With Worksheets("Formulation Archive").Range("A5:A10000")
        Set Z = .Find("", LookIn:=xlValues)
        If Not Z Is Nothing Then
        Z = Z.Row
        Worksheets("Formulation Archive").Range("A" & CStr(Z)).PasteSpecial
        End If
        End With
    Worksheets("Formulation Active").Rows(B).Delete
    End If
    Loop Until A Is Nothing
End With
    Blad2.Protect
    Blad5.Protect
    Application.ScreenUpdating = True

End Sub

 

[snb]

Dit kan in 4 regels; daarmee zijn de foutmeldingen ook van de baan.

for each cl in sheets("formulation active").columns(1).cells
  if cl.value<>"Complete" then cl.offset(,10)=" "
next
sheets("formulation active").columns(11).specialcells(xlcelltypeblanks).entirerow.copy sheets("formulation archive").rows(1)

 

[dannieshelp]

Type mismatch error

Ha SNB,

Wanneer ik jouw optie gebruik krijg ik een type mismatch error.
Moet ik die cl declareren ofzo?

Grt. Danny

 

[snb]

vorige code aangepast

 

[dannieshelp]

Application-defined/object-defined error

Ha snb,

Nu krijg ik weer een application-defined/object-defined error.

Danny

 

[snb]

kijk eens of de namen van de 2 werkboeken ("formulation active") en ("formulation archive") kloppen met de tekst in de macro en of beide geladen zijn. En ik hoop dat je de beveiliging erafgehaald hebt.