Copier coller avec condition

Ines2412 -  
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour,

Je suis novice sur VBA, et j'ai un souci :

Je commence par effacer les données d'un onglet pour copier coller de nouvelle valeurs puis
Je souhaiterai faire un copier coller des valeurs filtrés (jusque la tout va bien) mais si aucun résultat je souhaiterai qu'il n'y ai aucun résultat or dans l'onglet j'ai un message d'erreur et en faisant une gestion d'erreur il me colle toute les résultats

Voci la partie concernée : 

    'nb de fichiers à traiter
    NbFc = Range("TbFic").Rows.Count
For x = 3 To NbFc + 3
    Dir = "DDD"
    Ag = Sheets("Table de concordance").Range("B" & x).Offset(0, -1).Value
    Fc = Sheets("Table de concordance").Range("B" & x).Offset(0, 1).Value
    Dossier = Sheets("Table de concordance").Range("B" & x).Value
    Workbooks.Open ChemApp & "\" & Dossier & "\" & Fc
    Set WbFc = Workbooks(Fc)
    
     
'on rappatrie les données  de boxi sur
    WbApp.Activate
'on met les filtres
    Sheets("Stocks").Activate
    Set Plg = Range("TbBoxi")
    
'on filtre sur l'agence à traiter - 
            On Error Resume Next    'Erreur si aucun filtre présent
            Range("TbBoxi[#Headers]").Select
            ActiveSheet.ShowAllData 'suppression des filtres
            Plg.AutoFilter Field:=2, Criteria1:=Ag, Operator:=xlAnd
            Plg.AutoFilter Field:=5, Criteria1:="Attribution "
            Plg.AutoFilter Field:=14, Criteria1:="Oui"
            On Error GoTo 0 'annule la gestion d'erreur

'On rapattrie les données du fichierGV - Requête BO stock -
'On vide le fichier "1- GV.xls" de versement onglet Requete Bo Stock 'TbRqBo
With Workbooks("1- GV.xls").Sheets("Requête BO Stock").ListObjects(1)
    If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
    
End With    'Range("S2").FormulaR1C1 = "=RAND()"
    Workbooks("1- Garantie de versement.xls").Sheets("Requête BO Stock").Range("TbRqBo[Fonction aléa]").Cells(1, 1).FormulaR1C1 = "=RAND()"
    Set Plg = Range("TbBoxi").SpecialCells(xlCellTypeVisible)
    Plg.Copy Workbooks(Fc).Sheets("Requête BO Stock").Range("A2")


Je vous remercie pour votre aide

EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.
A voir également:

3 réponses

Réponse 1 / 3
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 584
 
bonsoir, quand tu fais "On Error Resume Next", tu décides: "si il y a une erreur, je continue l'instruction suivante comme si tout allait bien, comme si il n'y avait pas d'erreur".
j'imagines que tu souhaites faire autre chose en cas d'erreur.
peut-être souhaites-tu passer à l’occurrence suivante du "for x"?
cependant, tu n'expliques pas quoi, et tu ne partages qu'une partie de ton code.

par ailleurs, il est souvent préférable de prévenir les erreurs au lieu d'y réagir.
0
Réponse 2 / 3
Ines2412
 
Bsr,

Merci pr la réponse

En fait je souhaiterai en cas d'erreur (dans le cas où mon filtre n'a aucune occurence) qui l efface bien les données du fichier requête bo et qu'il passe à un autre fichier
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
pour commencer, peux-tu montrer le code complet, du for an next?
pour continuer, indiquer à quelles lignes de code correspondent "efface les données du fichier requête bo".
0
Réponse 3 / 3
Ines2412
 
Bonjour voici le code entier : 

Sub OuvrFich()
Application.ScreenUpdating = False
Dim Dir As String
Dim c As Range, Plg As Range
Dim Ag As String, Dossier As String, Fc As String
Dim DerLgAg As Integer, j As Byte

'Boucle pour choisir le fichier Ag à traiter
    'nb de fichiers à traiter
    NbFc = Range("TbFic").Rows.Count
For x = 3 To NbFc + 3
    Dir = "DDD"
    Ag = Sheets("Table de concordance").Range("B" & x).Offset(0, -1).Value
    Fc = Sheets("Table de concordance").Range("B" & x).Offset(0, 1).Value
    Dossier = Sheets("Table de concordance").Range("B" & x).Value
    Workbooks.Open ChemApp & "\" & Dossier & "\" & Fc
    Set WbFc = Workbooks(Fc)
    
     
'on rappatrie les données  de boxi sur
    WbApp.Activate
'on met les filtres
    Sheets("Stocks").Activate
    Set Plg = Range("TbBoxi")
    
'on filtre sur l'agence à traiter -  GV
            On Error Resume Next    'Erreur si aucun filtre présent
            Range("TbBoxi[#Headers]").Select
            ActiveSheet.ShowAllData 'suppression des filtres
            Plg.AutoFilter Field:=2, Criteria1:=Ag, Operator:=xlAnd
            Plg.AutoFilter Field:=5, Criteria1:="Attribution "
            Plg.AutoFilter Field:=14, Criteria1:="Oui"
            On Error GoTo 0 'annule la gestion d'erreur

'On rapattrie les données du fichier GV - Requête BO stock -
'On vide le fichier "1- GV.xls" de versement onglet Requete Bo Stock 'TbRqBo
With Workbooks("1- GV.xls").Sheets("Requête BO Stock").ListObjects(1)
    If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
End With    'Range("S2").FormulaR1C1 = "=RAND()"
    Workbooks("1- Garantie de versement.xls").Sheets("Requête BO Stock").Range("TbRqBo[Fonction aléa]").Cells(1, 1).FormulaR1C1 = "=RAND()"

  NbLg = Application.Subtotal(103, Columns("B")) 'si = 3 alors filtre vide (totaux)
        'on copie colle les données de boxi sur le fichier agence
        If NbLg >= 2 Then
            DerLgAg = Workbooks(Fc).Sheets("Requête BO stock").Range("A" & Rows.Count).End(xlUp).Row + 1
            '#Sélection de la plage à copier#
                Set Plg = Range("TbBoxi").SpecialCells(xlCellTypeVisible)
                    If DerLgAg = 2 And Range("A2") = "" Then '
                        DerLgAg = 2
                        Plg.Copy Workbooks(Fc).Sheets("Requête BO Stock").Range("A" & DerLgAg)
                    Else
                        Plg.Copy Workbooks(Fc).Sheets("Requête BO Stock").Range("A" & DerLgAg)
                    End If
    
    'Set Plg = Range("TbBoxi").SpecialCells(xlCellTypeVisible)
    'Plg.Copy Workbooks(Fc).Sheets("Requête BO Stock").Range("A2")
    
        

' RECUP DES NOMS & NIR A SUPERVISER POUR LE MOIS PRECEDENT
' Filtre le mois précédent
Dim NoLg As Integer, Supv As Range, i As Byte
Dim Doss As String, Lg As Long, a As Byte 'utile pour Do while
Application.ScreenUpdating = False

With Workbooks("1- GV.xls").Sheets("Requête BO Stock").Activate
      '    On supprime les tries précédent et on trie sur les aléas
           Sheets("Requête BO Stock").Range("TbRqBo").Sort _
            key1:=Range("TbRqBo[Fonction aléa]"), order1:=xlAscending, Header:=xlYes
    'on copie Le 1er Nom / NIR de Requête BO et on les colle dans Saisies s'il ne fait pas doublon
   
    If Sheets("Saisies").Range("B6") = "" Then
        Range("C2:D2").Copy
              Sheets("Saisies").Range("B6").PasteSpecial Paste:=xlPasteValues
    
    
    Else
        '   sinon, on prend le suivant
        a = 2   'indice ligne du Nir testé
            Doss = Range("D" & a)   'Nir à vérifier
            'dernière ligne de saisies
        With Sheets("Saisies")
            DerLg = .Range("B" & Rows.Count).End(xlUp).Row
        'on vérifie l'existance du 1er nir
            Set Plg = .Range("C6:C" & DerLg)
            Do While Application.WorksheetFunction.CountIf(Plg, Doss) >= 1
                MsgBox " Le nir a déjà été mis en supervision, nous testons le suivant."
                a = a + 1
                Doss = Range("D" & a)   'Nir à vérifier
            Loop
        End With
                'on copie colle le nouveau Nir de Requete BO Stock sur Saisie
                Range("C" & a & ":D" & a).Copy
                Sheets("saisies").Range("b" & DerLg + 1).PasteSpecial Paste:=xlPasteValues
     End If
     
Workbooks(Fc).Sheets("Saisies").Activate
Workbooks(Fc).Close True

'WbFc.Close True
Set WbFc = Nothing
Application.ScreenUpdating = True

End With

'on enlève les filtres
        Range("TbBoxi[#Headers]").Select
        ActiveSheet.ShowAllData 'suppression des filtres
'On libère la mémoire
        Set Plg = Nothing
Application.ScreenUpdating = True
 End If
 Next
End Sub


En fait, au moment ou l'onglet se vide si aucune occurence n'est trouvé dans le fichier de base, je souhaiterai qu'il reste vide et non qu'il me copie toute la base de données

L'erreur bloque à ce niveau : 

End If
    'Set Plg = Range("TbBoxi").SpecialCells(xlCellTypeVisible)
    'Plg.Copy Workbooks(Fc).Sheets("Requête BO Stock").Range("A2")

Il efface les données à ce niveau :

With Workbooks("1- GV.xls").Sheets("Requête BO Stock").ListObjects(1)
If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
End With 'Range("S2").FormulaR1C1 = "=RAND()"

Je te remercie pour ton aide
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
je n'ai pas tout compris.
je me demande si tu ne pourrais pas faire ainsi:
- au lieu de faire "on error resume next", faire "on error goto erreurfiltre"
- et ajouter quelque part: 
erreurfiltre:
     on error goto 0

de cette façon, au lieu de continuer comme si de rien était en cas d'erreur, le code va continuer à s'exécuter à l'endroit que tu choisis. tu devras peut-être déplacer certaines parties de code, par exemple déplacer avant le filtrage tout le code que tu veux toujours exécuter.
0
Ines2412
 
Bonjour,

Je viens de tester ça à l'air de fonctionner!!

Merci beaucoup!!!
0
Ines2412
 
En fait j'ai été trop hative, cela fonctionne pour le premier fichier mais pas le suivant:

J'ai l'erreur suivante

"Erreur d'execution 1004" Pas de cellules correspondantes et en effet il n'y a rien à copier

C'est la ligne ci dessous qui bloque :
Set Plg = Range("TbBoxi").SpecialCells(xlCellTypeVisible)

J'ai retravaillé le code c'est le suivant :

Sub OuvrFich()
Application.ScreenUpdating = False
Dim Dir As String
Dim c As Range, Plg As Range
Dim Ag As String, Dossier As String, Fc As String
Dim DerLgAg As Integer, j As Byte

'Boucle pour choisir le fichier Ag à traiter
'nb de fichiers à traiter
NbFc = Range("TbFic").Rows.Count
For x = 3 To NbFc + 3
Dir = "DAE"
Ag = Sheets("Table de concordance").Range("B" & x).Offset(0, -1).Value
Fc = Sheets("Table de concordance").Range("B" & x).Offset(0, 1).Value
Dossier = Sheets("Table de concordance").Range("B" & x).Value
Workbooks.Open ChemApp & "\" & Dossier & "\" & Fc
Set WbFc = Workbooks(Fc)


'on rappatrie les données de boxi sur
WbApp.Activate
'on met les filtres
Sheets("Stocks").Activate
Set Plg = Range("TbBoxi")

'on filtre sur l'agence à traiter - GV
On Error Resume Next 'Erreur si aucun filtre présent
Range("TbBoxi#Headers").Select
ActiveSheet.ShowAllData 'suppression des filtres
Plg.AutoFilter Field:=2, Criteria1:=Ag, Operator:=xlAnd
Plg.AutoFilter Field:=5, Criteria1:="Attribution "
Plg.AutoFilter Field:=14, Criteria1:="Oui"
On Error GoTo 0 'annule la gestion d'erreur

'On rapattrie les données du fichier GV - Requête BO stock -
'On vide le fichier "1- GV.xls" de versement onglet Requete Bo Stock 'TbRqBo
With Workbooks("1- GV.xls").Sheets("Requête BO Stock").ListObjects(1)
If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete

End With 'Range("S2").FormulaR1C1 = "=RAND()"

Workbooks("1- GV.xls").Sheets("Requête BO Stock").Range("TbRqBo[Fonction aléa]").Cells(1, 1).FormulaR1C1 = "=RAND()"
On Error GoTo erreurfiltre
Set Plg = Range("TbBoxi").SpecialCells(xlCellTypeVisible)
Plg.Copy Workbooks(Fc).Sheets("Requête BO Stock").Range("A2")


erreurfiltre:
On Error GoTo 0

Next
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584 > Ines2412
 
tu as l'erreur malgré le "on error"?
0

Discussions similaires

dessin avec symbole clavier
JSS -
Adraen -

79 réponses
Arobase (@)
NöNö$ -
NöNö$ -

2 réponses
comment faire une arobase
GLORIA -
baladur13 -

1 réponse
Arobase
Zezette -
MPMP10 -

1 réponse
dessin au clavier cannabis
val2t1 -
Mamaaaa18 -

10 réponses