Macro/VBA copier/coller avec condition

Bonjour,

Voici mon problème, l'idée c'est d'avoir un classeur pilote qui ventile grâce à une macro les données.

J'ai un classeur nommé "TAB_Test_ASR_RequeteReexamensMai2017_20170209.xlsx" ou en "colonne V" je renseigne le type de courriers que je souhaite envoyer. Une fois le type de courrier renseigné je souhaite transférer uniquement le NIR, Nom Complet, Adresse, CP et Ville (colonne de A à E) dans un autre classeur nommé "TAB_Publi_20161207.xlsx". Difficulté supplémentaire j'aimerais quand fonction du courrier choisi le NIR, Nom Complet, Adresse, CP et Ville se colle dans l'onglet correspondant au type de courrier sélectionné (12 onglets nommés : "AI" - "AI et QPS" - "AI et QPS avec KK" '- "QPS" - "QPS avec KK" - "Facture hébergement" - "AI et facture hébergement" - "AI et QC" - "AI et QC avec KK" - "QC" - "QC avec KK" - "Rejet ressources supérieures").

Merci!

Salut,

Il me faut les noms de tes classeurs (tu pourras anonymiser et rechanger par la suite) et l'intitulé de la colonne département.

Bonjour le fil, bonjour le forum,

Une proposition (à adapter) à mettre dans le Classeur A et à lancer.

Le code considère que tous les classeur se trouvent dans le même dossier que celui du Classeur A. Il ouvre les classeur les uns après les autres, copie les données, enregistre et ferme le classeur puis, passe au classeur suivant.

Non testé, je t'en laisse le soin...

Si le tableau source contient des en-têtes, la boucle sur toutes les ligne I du tableau des valeurs TV doit commencer à la ligne 2 et devient : For I = 2 to ...

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheets 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim TC(1 To 5) As String 'déclare la variable TC (Tableau des Classeurs)
Dim TD(1 To 5) As Byte 'déclare la variable TD (Tableau des Départements)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim CD As Workbook 'déclare la variable CS (Classeur Source)
Dim OD As woorksheet 'déclare la variable OD (Onglet Destination)
Dim X As Byte 'déclare la variable X (incrément)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set CS = ThisWorkbook 'définit la classeur source CS
Set OS = CS.Sheets(1) 'définit l'onglet source OS
CA = CS.Path & "\" 'définit le chemin d'accès CA
TC(1) = "Classeur C.xlsx" 'définit la variable indéxée TC(1) (nom et extension à adapter)
TC(2) = "Classeur D.xlsx" 'définit la variable indéxée TC(2) (nom et extension à adapter)
TC(3) = "Classeur E.xlsx" 'définit la variable indéxée TC(3) (nom et extension à adapter)
TC(4) = "Classeur F.xlsx" 'définit la variable indéxée TC(4) (nom et extension à adapter)
TC(5) = "Classeur G.xlsx" 'définit la variable indéxée TC(5) (nom et extension à adapter)
TD(1) = 44 'définit la variable indéxée TD(1)
TD(2) = 85 'définit la variable indéxée TD(2)
TD(3) = 72 'définit la variable indéxée TD(3)
TD(4) = 53 'définit la variable indéxée TD(4)
TD(5) = 49 'définit la variable indéxée TD(5)
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
Workbooks.Open (CS & "Classeur B.xlsx") 'ouvre le classeur B (nom à adapter)
Set CD = ActiveWorkbook 'définit le classeur destination CD
Set OD = CD.Sheets(1) 'définit l'onglet destination OD (index ou nom à adapter)
Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
DEST.Resize(NL, NC).Value = TV 'renvoie le tableau TV dans la cellule DEST redimensionné
CD.Close Savechanges:=True 'ferme le claseur destination après avoir enregistrer les changements (supprimer cette ligne si tu veux garder le classeur ouvert)

For X = 1 To 5 'boucle 1 : sur les 5 classeurs/départements
    K = 1 'initialise la variable K
    For I = 1 To NL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV
        If TV(I, 4) = TD(X) Then 'condition : si la donnée ligne I colonne 4 de TV est égale à la variable indexée TD(X)
            ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL
            For J = 1 To NC 'boucle 3 : sur toutes les colonnes de TV
                TL(J, K) = TV(I, J) 'récupère dans la ligne J de TL la données colonne J de TV (= Transposition)
            Next J 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne à TL)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    If K > 1 Then 'condition : si K est supérieure à 1
        Workbooks.Open (CS & TC(X)) 'boucle le classeur de la variable indexée TC(X)
        Set CD = ActiveWorkbook 'définit le classeur destination CD
        Set OD = CD.Sheets(1) 'définit l'onglet destination OD
        Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
        DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans DEST redimensionnée le tableau TL transposé
        Erase TL 'vide le tableau TL
        CD.Close Savechanges:=True 'ferme le claseur destination après avoir enregistrer les changements (supprimer cette ligne si tu veux garder les classeurs ouverts)
    End If 'fin de la condition
Next X 'prochain classeur/département de la boucle 1
End Sub

Re,

Nono78 l'intitulé de mes classeurs sont "Classeur A", "Classeur B", "Classeur C", "Classeur D", "Classeur E", "Classeur F" et "Classeur G". Ma colonne département, s'intitule "Département".

Merci pour ton aide!


Re,

Merci beaucoup ThauThème pour ta proposition je vais tester tout ça je te tiens au jus!


nono78 a écrit :

Salut,

Il me faut les noms de tes classeurs (tu pourras anonymiser et rechanger par la suite) et l'intitulé de la colonne département.

Re,

Nono78 l'intitulé de mes classeurs sont "Classeur A", "Classeur B", "Classeur C", "Classeur D", "Classeur E", "Classeur F" et "Classeur G". Ma colonne département, s'intitule "Département".

Merci pour ton aide!


[quote="ThauThème"]Bonjour le fil, bonjour le forum,

Re,

Merci beaucoup ThauThème pour ta proposition je vais tester tout ça je te tiens au jus!

[quote="ThauThème"]Bonjour le fil, bonjour le forum,

Bon, j'ai essayé ta super macro mais malheureusement je n'arrive pas à la faire fonctionner. Peux-tu me donner de nouveau un petit coup de pouce j'en serais très reconnaissant car je suis un vrai débutant en la matière. Je te joins les différents fichiers qui sont tous dans le même document sous "C:\Users\F3996\Documents\Dossier sources copier coller".

Est ce qu'il y a la possibilité au lieu de mettre le bouton sur le classeur A d'avoir un fichier pilote avec ce bouton uniquement car mon fichier A est nouveau tous les mois (donc ça m'oblige à réinstaller le bouton à chaque fois). On pourrait appeler ce fichier "Classeur Pilote".

Merci!

capture
13classeur-a.xlsm (21.04 Ko)
10classeur-b.xlsx (9.85 Ko)
6classeur-c.xlsx (9.64 Ko)
9classeur-d.xlsx (9.63 Ko)
11classeur-e.xlsx (9.63 Ko)
9classeur-g.xlsx (9.63 Ko)
13classeur-f.xlsx (9.63 Ko)

Bonjour,

En pièce jointe le Classeur Pilote.xlsm, indépendant des autres fichiers, avec la macro corrigée et testée. Ça marche bien sauf que les colonnes des fichiers Destination (B, C, D, E, F et G) ne correspondent pas aux colonnes du fichier Source (A)... je te laisse le soin de réparer.

Attention ton fichier Classeur A.xlms, de fait, redevient Classeur A.xlsx puisqu'il n'a plus de macros. Tu dois l'Enregister Sous...

[quote="ThauThème"]Bonjour,

Bonjour,

Tout d'abord je tiens à te remercier pour ton travail exceptionnel, Merci!

Ton fichier marche parfaitement, j'ai procédé à la modification des colonnes. J'ai juste un petit souci avec le classeur B (celui qui réceptionne l'ensemble des données) il me copie-colle l'en-tête des colonnes à chaque mise à jour. Est-il possible qui me colle uniquement les informations sans les en-têtes comme c'est le cas avec les autres classeurs? Est-il aussi possible de garder le format numérique d'origine quand il effectue le copier/coller? Enfin, si j'ai une formule dans mon classeur de base peux-t-il la garder sans me donner uniquement le résultat de la formule mais la formule telle qu'elle était?

Merci le génie!

20classeur-a.xlsx (12.08 Ko)
16classeur-b.xlsx (10.02 Ko)
11classeur-c.xlsx (9.93 Ko)
13classeur-d.xlsx (9.80 Ko)
13classeur-e.xlsx (9.80 Ko)
15classeur-f.xlsx (9.80 Ko)
15classeur-g.xlsx (9.80 Ko)

Bonjour,

Code modifié :

Sub Macro1()
Dim CP As Workbook 'décalre la variable CP (Classeur Pilote)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim TC(1 To 5) As String 'déclare la variable TC (Tableau des Classeurs)
Dim TD(1 To 5) As Byte 'déclare la variable TD (Tableau des Départements)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim CD As Workbook 'déclare la variable CS (Classeur Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim X As Byte 'déclare la variable X (incrément)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Application.DisplayAlerts = False 'masque les message d'Excel
TC(1) = "Classeur C.xlsx" 'définit la variable indéxée TC(1) (nom et extension à adapter)
TC(2) = "Classeur D.xlsx" 'définit la variable indéxée TC(2) (nom et extension à adapter)
TC(3) = "Classeur E.xlsx" 'définit la variable indéxée TC(3) (nom et extension à adapter)
TC(4) = "Classeur F.xlsx" 'définit la variable indéxée TC(4) (nom et extension à adapter)
TC(5) = "Classeur G.xlsx" 'définit la variable indéxée TC(5) (nom et extension à adapter)
TD(1) = 44 'définit la variable indéxée TD(1)
TD(2) = 85 'définit la variable indéxée TD(2)
TD(3) = 72 'définit la variable indéxée TD(3)
TD(4) = 53 'définit la variable indéxée TD(4)
TD(5) = 49 'définit la variable indéxée TD(5)
Set CP = ThisWorkbook 'définit le classeur pilote CP
CA = CP.Path & "\" 'définit le chemin d'accès CA
Set CS = Workbooks.Open(CA & "Classeur A.xlsx") 'ouvre le classeur A et définit la classeur source CS
Set OS = CS.Sheets(1) 'définit l'onglet source OS
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
Set CD = Workbooks.Open(CA & "Classeur B.xlsx") 'ouvre le classeur B et définit le classeur destination CD
Set OD = CD.Sheets(1) 'définit l'onglet destination OD (index ou nom à adapter)
Set DEST = IIf(OD.Range("A2") = "", OD.Range("A2"), OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)) 'définit la cellule de destination DEST
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL
    For J = 1 To NC 'boucle 3 : sur toutes les colonnes de TV
        TL(J, K) = TV(I, J) 'récupère dans la ligne J de TL la données colonne J de TV (= Transposition)
    Next J 'prochaine colonne de la boucle 3
    K = K + 1 'incrémente K (ajoute une colonne à TL)
Next I 'prochaine ligne de la boucle 2
If K > 1 Then 'condition : si K est supérieure à 1
    DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans DEST redimensionnée le tableau TL transposé
    Erase TL 'vide le tableau TL
    CD.Close SaveChanges:=True 'ferme le classeur destination après avoir enregistrer les changements (supprimer cette ligne si tu veux garder les classeurs ouverts)
CS.Close SaveChanges:=False 'ferme le classeur source CS sans enregistrer les changements
End If 'fin de la condition

For X = 1 To 5 'boucle 1 : sur les 5 classeurs/départements
    K = 1 'initialise la variable K
    For I = 2 To NL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 4) = TD(X) Then 'condition : si la donnée ligne I colonne 4 de TV est égale à la variable indexée TD(X)
        ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL
            For J = 1 To NC 'boucle 3 : sur toutes les colonnes de TV
                TL(J, K) = TV(I, J) 'récupère dans la ligne J de TL la données colonne J de TV (= Transposition)
            Next J 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne à TL)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    If K > 1 Then 'condition : si K est supérieure à 1
        Workbooks.Open (CA & TC(X)) 'boucle le classeur de la variable indexée TC(X)
        Set CD = ActiveWorkbook 'définit le classeur destination CD
        Set OD = CD.Sheets(1) 'définit l'onglet destination OD
        Set DEST = IIf(OD.Range("A2") = "", OD.Range("A2"), OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)) 'définit la cellule de destination DEST
        DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans DEST redimensionnée le tableau TL transposé
        Erase TL 'vide le tableau TL
        CD.Close SaveChanges:=True 'ferme le claseur destination après avoir enregistrer les changements (supprimer cette ligne si tu veux garder les classeurs ouverts)
    End If 'fin de la condition
Next X 'prochain classeur/département de la boucle 1
Application.DisplayAlerts = True 'affiche les message d'Excel
Application.ScreenUpdating = True 'masque les rafraîchissements d'écran
MsgBox "L'envoie des données est terminé !" 'message
End Sub

Juste une question ? Pourquoi je m'emm... à commenter le code ?

[quote="ThauThème"]Bonjour,

Re,

C'est tout simplement exceptionnel encore merci!

Est-ce qu'il a la possibilité de garder la formule entrée dans le "classeur A"- colonne E intitulée "Adresse" qui lorsqu'elle est copiée/collée se garde en formule et non en résultat tout comme pour les formats numériques de cellule?

Les commentaires que tu as ajouté me seront très utiles quand je serais un peu plus expert en la matière car pour le moment ça reste du chinois mais ça m'éclaircis un peu sur la logique utilisée.

Big up!

Rechercher des sujets similaires à "macro vba copier coller condition"