Copier coller avec condition
Ines2412
-
yg_be Messages postés 24281 Date d'inscription Statut Contributeur Dernière intervention -
yg_be Messages postés 24281 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 :
Je vous remercie pour votre aide
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:
- Copier coller avec condition
- Historique copier coller - Guide
- Copier-coller - Accueil - Informatique
- Copier coller pdf - Guide
- Style d'écriture a copier coller - Guide
- Excel cellule couleur si condition texte - Guide
3 réponses
yg_be
Messages postés
24281
Date d'inscription
Statut
Contributeur
Dernière intervention
Ambassadeur
1 585
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.
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.
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
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
Bonjour voici le code entier :
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 :
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
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
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:
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.
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.
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
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