Recopie de colonnes avec condition de date dans 2 colonnes

H

heparti

XLDnaute Occasionnel
Bonjour,

Je fais appel à vous car j'ai commencé d'élaborer une macro qui recopie certaines colonnes d'un fichier vers un autre fichier et cela fonctionne très bien.

En plus, je souhaite ajouter une condition à cette recopie, c'est à dire qu'il faudrait que la recopie ne se fasse qu'à condition qu'une date comprise entre le 01/01/2014 et le 31/12/2014 soit saisie dans les colonnes S ou T.

Voici la macro actuelle à compléter.

Merci pour votre aide :p

Sub collage()
'
'
Workbooks.Open "\\chemin d'accès\résutat macro PP.xlsx"
Sheets("suivi obs").Unprotect Password:="motdepasse"

With Workbooks("test sd.xls").Sheets("TABLEAU SUIVI")
If .AutoFilterMode Then
.Cells.AutoFilter
End If
End With


' copie les cellules masquées
Sheets("suivi obs").Range("a1:g400").Copy Workbooks("résutat macro PP.xlsx").Sheets("suivi obs").Range("A1")
Workbooks("test sd.xls").Sheets("TABLEAU SUIVI").Range("d1:h400").Copy _
Destination:=Workbooks("résutat macro PP.xlsx").Sheets("suivi obs").Range("a1:e400")
Workbooks("test sd.xls").Sheets("TABLEAU SUIVI").Range("s1:t400").Copy _
Destination:=Workbooks("résutat macro PP.xlsx").Sheets("suivi obs").Range("f1:g400")

With Workbooks("test sd.xls").Sheets("TABLEAU SUIVI")
If Not .AutoFilterMode Then
.Cells.AutoFilter
End If
End With



Sheets("suivi obs IAE").Protect Password:="motdepasse", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
Workbooks("résutat macro PP.xlsx").Activate
ActiveWorkbook.Save
Workbooks("résutat macro PP.xlsx").Close
ActiveWorkbook.Save

End Sub
Cliquez pour agrandir...
 
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : Recopie de colonnes avec condition de date dans 2 colonnes

Bonsoir Heparti, bonsoir le forum,

Pas facile de t'aider sans les fichiers qui vont avec le code. Obliger de tout recréer, les fichiers, les onglets , les données, etc. En principe je ne le fait plus quand le demandeur ne le fait pas lui-même...
Voilà comment j'ai vu les choses. J'imagine que le code doit se trouver dans le classeur test sd.xls :
Code: 
Sub collage()
Dim C1 As Workbook 'déclare la variable C1 (Classuer 1)
Dim C2 As Workbook 'déclare la variable C2 (Classuer 2)
Dim O1 As Object 'déclare la variable O1 (Onglet 1)
Dim O2 As Object 'déclare la variable O2 (Onglet 2)
Dim NON As Byte 'déclare la variable NON
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)

Workbooks.Open "\\chemin d'accès\résutat macro PP.xlsx"
Set C1 = ActiveWorkbook 'définit la classeur C1
Set O1 = C1.Sheets("suivi obs") 'définit l'onglet O1
O1.Unprotect Password:="motdepasse"
'définit le classeur C2 (si c'est le classeur qui contient la macro on peut aussi écrire : [Set C2 = ThisWorkbook])
Set C2 = Workbooks("test sd.xls")
Set O2 = C2.Sheets("TABLEAU SUIVI") 'définit l'onglet O2

'************************************************************************************
'cette partie permet de déterminer si il y a des date de 2014 dans les colonne S ou T

If O2.FilterMode = True Then O2.AutoFilterMode = False 'so O2 est filtré, supprime le filtre
'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O2 (à adapter à ton cas)
DL = O2.Cells(Application.Rows.Count, 1).End(xlUp).Row
Set PL = O2.Range("A1:A" & DL) 'définit la plage PL (à adapter à ton cas)
'filtre la colonne 19 (=S) pour toutes les dates de 2014
O2.Range("A1").AutoFilter Field:=19, Criteria1:=">=2014/01/01", Operator:=xlAnd, Criteria2:="<=2014/12/31"
'si le nombre de cellule visibles de la plage PL est égal à 1 (ce qui signifie qu'il n'y a aucune date de 2014), NON = 1
If PL.SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then NON = 1
O2.Range("A1").AutoFilter Field:=19 'supprime le filte de la colonne 19
'filtre la colonne 20 (=T) pour toutes les dates de 2014
O2.Range("A1").AutoFilter Field:=20, Criteria1:=">=2014/01/01", Operator:=xlAnd, Criteria2:="<=2014/12/31"
'si le nombre de cellule visibles de la plage PL est égal à 1 (ce qui signifie qu'il n'y a aucune date de 2014), NON = NON + 1
If PL.SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then NON = NON + 1
O2.AutoFilterMode = False 'supprime le filtre automatique
If NON = 2 Then Exit Sub 'si NON=2 (donc aucune date de 2014 ni en colonne S, ni en colonne T), sort de la procédure
'************************************************************************************

'à ce stade là, si le code continie c'est qu'il y a au moins une date de 2014 en colonne S ou T
' copie les cellules masquées
O2.Range("a1:g400").Copy O1.Range("A1")
O2.Range("d1:h400").Copy O1.Range("a1:e400")
O2.Range("s1:t400").Copy O1.Range("f1:g400")

'Sheets("suivi obs IAE").Protect Password:="motdepasse", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
'bizarrement l'onglet est devenu "IAE" ou cé st un autre onglet ????
O1.Protect Password:="motdepasse", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True

C1.Close SaveChanges:=True
C2.Save
End Sub
 
Vote positif 0 Vote négatif
H

heparti

XLDnaute Occasionnel
Re : Recopie de colonnes avec condition de date dans 2 colonnes

Je te remercie pour le temps que tu as passé à essayer de répondre à ma demande et ensuite je m'excuse pour l'absence de pièce jointe.

J'ai testé ta macro mais j'ai une erreur à cette ligne :

Code: 
DL = O2.Cells(Application.Rows.Count, 1).End(xlUp).Row

Afin que tu puisses avoir tous les éléments à disposition, voici les 2 fichiers expurgés des données mais utilisables.

Merci pour ton aide.
 

Pièces jointes

  • test sd.xls
    132 KB · Affichages: 46
  • résutat macro PP.xlsx
    9 KB · Affichages: 31
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : Recopie de colonnes avec condition de date dans 2 colonnes

Bonsoir Heparti, bonsoir le forum,

Tu as raison, ça plante mais pas toujours. En fait quand le classeur actif et C1. Donc, sans vraiment comprendre pourquoi, en rajoutant la ligne :
Code: 
C2.Activate 'active le classeur C2
juste avant :
Code: 
If O2.FilterMode = True Then O2.AutoFilterMode = False 'so O2 est filtré, supprime le filtre
ça semble fonctionner...
 
Vote positif 0 Vote négatif
H

heparti

XLDnaute Occasionnel
Re : Recopie de colonnes avec condition de date dans 2 colonnes

Merci Robert pour ton aide.

Alors, point de jour : la macro fonctionne, plus d'erreur, sauf que le filtre sur la date en colonnes S et T ne fonctionne pas. Toutes les lignes sont recopiées.:(
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : Recopie de colonnes avec condition de date dans 2 colonnes

Bonjour Heparti, bonjour le forum,

Mauvaise interprétation de ma part. Quand tu disais :
Je fais appel à vous car j'ai commencé d'élaborer une macro qui recopie certaines colonnes d'un fichier vers un autre fichier et cela fonctionne très bien.
En plus, je souhaite ajouter une condition à cette recopie, c'est à dire qu'il faudrait que la recopie ne se fasse qu'à condition qu'une date comprise entre le 01/01/2014 et le 31/12/2014 soit saisie dans les colonnes S ou T.
Cliquez pour agrandir...
Je pensais que tu voulais recopier tout uniquement si il y avait des dates de 2014 et pas que tu voulais recopier uniquement les dates de 2014...
Mais du coup je sais plus je ne sais plus comment adapter le code. Faut-il recopier une ligne dont les deux colonnes S et T contiennent chacune une date de 2014 ou, il suffit que l'une des deux colonnes contiennent une date pour que la ligne soit recopiée ?
 
Vote positif 0 Vote négatif
H

heparti

XLDnaute Occasionnel
Re : Recopie de colonnes avec condition de date dans 2 colonnes

Autant pour moi, je me suis mal exprimé dans mon premier post.

Je souhaite que ne soient copiés que les lignes contenant une date de 2014 soit en colonne S ou T.:eek:
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : Recopie de colonnes avec condition de date dans 2 colonnes

Bonjour Heparti, bonjour le forum,

Un code plus long à s'exécuter mais qui semble correspondre :
Code: 
Sub collage()
Dim C1 As Workbook 'déclare la variable C1 (Classuer 1)
Dim C2 As Workbook 'déclare la variable C2 (Classuer 2)
Dim O1 As Object 'déclare la variable O1 (Onglet 1)
Dim O2 As Object 'déclare la variable O2 (Onglet 2)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim TEST As Boolean 'déclare la variable TEST

Set C2 = ThisWorkbook 'définit le classeur C2
Set O2 = C2.Sheets("TABLEAU SUIVI") 'définit l'onglet O2
DL = O2.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A)
Set PL = O2.Range("S2:S" & DL) 'définit la plage PL
Workbooks.Open "\\chemin d'accès\résutat macro PP.xlsx"
Set C1 = ActiveWorkbook 'définit la classeur C1
Set O1 = C1.Sheets("suivi obs IAE") 'définit l'onglet O1
O1.Unprotect Password:="motdepasse"
For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL
    If Year(CEL.Value) = 2014 Then 'condition : si l'année de la valeur de la cellule CEL est égale à 2014
        Set DEST = IIf(O1.Range("A1") = "", O1.Range("A1"), O1.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)) 'définit la cellule de destination DEST
        O2.Range(O2.Cells(CEL.Row, 1), O2.Cells(CEL.Row, 7)).Copy DEST 'copie la plage A1:G1 de la cellule et la colle dans DEST (je ne comprends pas cette ligne puisqu'on l'écrase par la suite...)
        O2.Range(O2.Cells(CEL.Row, 4), O2.Cells(CEL.Row, 8)).Copy DEST 'copie la plage D1:H1 de la cellule et la colle dans DEST
        O2.Range(O2.Cells(CEL.Row, 19), O2.Cells(CEL.Row, 20)).Copy DEST.Offset(0, 5) 'copie la plage S1:T1 de la cellule et la colle dans DEST décalée de 5 colonnes à droite (=colonne F)
        TEST = True 'définit la variable TEST
    End If 'fin de la condition
    If TEST = True Then GoTo suite 'si test est vrai la ligne a déja été copiée, va à l'étiquette "suite"
    If Year(CEL.Offset(0, 1).Value) = 2014 Then 'condition : si l'année de la valeur de la cellule CEL décalé d'une colonne à droite (=colonne T) est égale à 2014
        Set DEST = IIf(O1.Range("A1") = "", O1.Range("A1"), O1.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)) 'définit la cellule de destination DEST
        O2.Range(O2.Cells(CEL.Row, 1), O2.Cells(CEL.Row, 7)).Copy DEST 'copie la plage A1:G1 de la cellule et la colle dans DEST (je ne comprends pas cette ligne puisqu'on l'écrase par la suite...)
        O2.Range(O2.Cells(CEL.Row, 4), O2.Cells(CEL.Row, 8)).Copy DEST 'copie la plage D1:H1 de la cellule et la colle dans DEST
        O2.Range(O2.Cells(CEL.Row, 19), O2.Cells(CEL.Row, 20)).Copy DEST.Offset(0, 5) 'copie la plage S1:T1 de la cellule et la colle dans DEST décalée de 5 colonnes à droite (=colonne F)
    End If 'fin de la condition
suite: 'étiquette
    TEST = False 'réinitialise la variable test
Next CEL 'prochaine cellule de la boucle
O1.Protect Password:="motdepasse", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
C1.Close SaveChanges:=True
C2.Save
End Sub
 
Vote positif 0 Vote négatif
H

heparti

XLDnaute Occasionnel
Re : Recopie de colonnes avec condition de date dans 2 colonnes

Merci Robert, effectivement, cela fonctionne parfaitement.

Je teste à nouveau demain et je te fais un retour pour valider ton code.

Encore merci pour le temps que tu as passé à m'aider ;)
 
Vote positif 0 Vote négatif
H

heparti

XLDnaute Occasionnel
Re : Recopie de colonnes avec condition de date dans 2 colonnes

Me revoici.

J'ai continué mes tests et je voulais savoir s'il était possible de vider la feuille de destination avant tout recopie ?

En effet, à chaque exécution de la macro, les lignes de rajoutent à la suite de la précédente recopie.


C'est la seule modification qu'il convient d'apporter à ton code ;)
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : Recopie de colonnes avec condition de date dans 2 colonnes

Bonjour Heparti, bonjour le forum,

rajoute la ligne :
Code: 
O1.Range("A1").CurrentRegion.Clear 'efface d'éventuelles anciennes données
juste après celle-ci :
Code: 
O1.Unprotect Password:="motdepasse"
Le code complet :
Code: 
Sub collage()
Dim C1 As Workbook 'déclare la variable C1 (Classuer 1)
Dim C2 As Workbook 'déclare la variable C2 (Classuer 2)
Dim O1 As Object 'déclare la variable O1 (Onglet 1)
Dim O2 As Object 'déclare la variable O2 (Onglet 2)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim TEST As Boolean 'déclare la variable TEST

Set C2 = ThisWorkbook 'définit le classeur C2
Set O2 = C2.Sheets("TABLEAU SUIVI") 'définit l'onglet O2
DL = O2.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A)
Set PL = O2.Range("S2:S" & DL) 'définit la plage PL
Workbooks.Open "\\chemin d'accès\résutat macro PP.xlsx"
Set C1 = ActiveWorkbook 'définit la classeur C1
Set O1 = C1.Sheets("suivi obs IAE") 'définit l'onglet O1
O1.Unprotect Password:="motdepasse"
O1.Range("A1").CurrentRegion.Clear 'efface d'éventuelles anciennes données
For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL
    If Year(CEL.Value) = 2014 Then 'condition : si l'année de la valeur de la cellule CEL est égale à 2014
        Set DEST = IIf(O1.Range("A1") = "", O1.Range("A1"), O1.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)) 'définit la cellule de destination DEST
        O2.Range(O2.Cells(CEL.Row, 1), O2.Cells(CEL.Row, 7)).Copy DEST 'copie la plage A1:G1 de la cellule et la colle dans DEST (je ne comprends pas cette ligne puisqu'on l'écrase par la suite...)
        O2.Range(O2.Cells(CEL.Row, 4), O2.Cells(CEL.Row, 8)).Copy DEST 'copie la plage D1:H1 de la cellule et la colle dans DEST
        O2.Range(O2.Cells(CEL.Row, 19), O2.Cells(CEL.Row, 20)).Copy DEST.Offset(0, 5) 'copie la plage S1:T1 de la cellule et la colle dans DEST décalée de 5 colonnes à droite (=colonne F)
        TEST = True 'définit la variable TEST
    End If 'fin de la condition
    If TEST = True Then GoTo suite 'si test est vrai la ligne a déja été copiée, va à l'étiquette "suite"
    If Year(CEL.Offset(0, 1).Value) = 2014 Then 'condition : si l'année de la valeur de la cellule CEL décalé d'une colonne à droite (=colonne T) est égale à 2014
        Set DEST = IIf(O1.Range("A1") = "", O1.Range("A1"), O1.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)) 'définit la cellule de destination DEST
        O2.Range(O2.Cells(CEL.Row, 1), O2.Cells(CEL.Row, 7)).Copy DEST 'copie la plage A1:G1 de la cellule et la colle dans DEST (je ne comprends pas cette ligne puisqu'on l'écrase par la suite...)
        O2.Range(O2.Cells(CEL.Row, 4), O2.Cells(CEL.Row, 8)).Copy DEST 'copie la plage D1:H1 de la cellule et la colle dans DEST
        O2.Range(O2.Cells(CEL.Row, 19), O2.Cells(CEL.Row, 20)).Copy DEST.Offset(0, 5) 'copie la plage S1:T1 de la cellule et la colle dans DEST décalée de 5 colonnes à droite (=colonne F)
    End If 'fin de la condition
suite: 'étiquette
    TEST = False 'réinitialise la variable test
Next CEL 'prochaine cellule de la boucle
O1.Protect Password:="motdepasse", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
C1.Close SaveChanges:=True
C2.Save
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
365
M@xu3L
M
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
535
mouchtre
mouchtre
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
111
marie3107
M
P
  • Question
Microsoft 365 Problème de destination à l'exécution d'une macro
Réponses
2
Affichages
286
Pimpon974
P
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
160
marie3107
M
Y
  • Question
XL 2013 Macro positionnée dans le code d'un feuille
Réponses
10
Affichages
294
Dranreb
Dranreb
M
  • Question
XL 2013 Envoyer un mail automatique avec le contenu de la bonne ligne
Réponses
2
Affichages
652
Oneida
Oneida
cocro
  • Question
Microsoft 365 Créer autant d'onglet que de commune dans ma base principale
Réponses
14
Affichages
365
job75
job75
E
  • Résolu(e)
Microsoft 365 Absences dans Planning
2
Réponses
28
Affichages
1 K
ChTi160
ChTi160
Usine à gaz
  • Résolu(e)
XL 2021 touches Ctrl+R pour revenir
Réponses
4
Affichages
305
TooFatBoy
TooFatBoy

Membres actuellement en ligne

31 membres et 410 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 300
Messages
2 087 008
Membres
103 429
dernier inscrit
PhilippeH