Copier les tableaux contenant les dates vers une feuille

Bonjour

J'aimerais dans la mesure du possible avoir une macro qui permet de copier le contenu des tableaux des 4 feuilles uniquement pour les lignes qui contiennent les dates dans la colonnes S et les envoyer vers la feuille courrier.

Les titres des tableaux sont les mêmes (en nombre et en nom)

Je met en joint le fichier exemple (j'ai mis au hasard le contenu des cellules) .

Très cordialement

Bonjour Moataz, bonjour le forum,

Essaie comme ça :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set OD = Worksheets("courrier") 'définit l'onglet OD
For Each OS In Worksheets 'boucle sur tous les onglets OS du classeurs
    If Not OS.Name = OD.Name Then 'condition 1 : si l'onglet de la boucle n'est pas l'onglet source
        TV = OS.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
        For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeur (en partant de la seconde)
            If TV(I, 19) <> "" Then 'condition 2 : si la donnée ligne I colonne 19 (=> colonne S) n'est pas vide
                Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit al cellule de destination DEST (première cellule vide de la colonne A de l'onglet OD)
                DEST.Resize(1, UBound(TV, 2)).Value = Application.Index(TV, I) 'renvoie dans DEST redimensionnée la ligne I du tableau TV
            End If 'fin de la condition 2
        Next I 'prochaine ligne de la boucle 2
    End If 'fin de la condition 1
Next OS 'prochain onglet de la boucle 1
End Sub

merci beaucoup...je vais tester ça une fois chez moi.

juste une précision je vois que vous avez pas nommer les noms des feuilles dans le code...car j'ai oublié de préciser que le classeur contient plusieurs feuilles autres que j'ai mis dans le fichier joint......

Re,

Pas besoin de les nommer on boucle sur tous les onglets autres que courrier...

Merci bcp....le code marche très bien.

le petit soucis c'est qu'il copie les autres feuilles du classeur qui contiennent des tableaux similaires.....sauf que les autres tableaux ont les dates dans la colonne O.

Au début je voulais juste 1 macro pour les 4 premières feuilles et par la suite j'allais l'adapter aux autres de la colonne O pour avoir 2 macros. ...Maintenant s'il y a possibilité qu'1 macro fasse tout le boulot ça serait TOP

en PJ le fichier mis à jour

Re,

Essaie comme ça alors :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim COL As Integer 'déclare la variable COL
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set OD = Worksheets("courrier") 'définit l'onglet OD
For Each OS In Worksheets 'boucle sur tous les onglets OS du classeurs
    If OS.Name <> OD.Name Then 'si l'onglet source n'est pas l'onglet destination
        Select Case OS.Name 'agit en fontion du nom de l'onglet OS de la boucle
            Case "FAD", "ADN", "PH", "BASIC" 'cas
                COL = 19 'définit la colonne COL
            Case "ana", "PALME", "Vente", "Action" 'cas
                COL = 15 'définit la colonne COL
        End Select 'fin de l'action en fonction du nom de l'onglet OS de la boucle
        TV = OS.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
        For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeur (en partant de la seconde)
            If TV(I, COL) <> "" Then 'condition 2 : si la donnée ligne I colonne COL n'est pas vide
                Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit al cellule de destination DEST (première cellule vide de la colonne A de l'onglet OD)
                DEST.Resize(1, UBound(TV, 2)).Value = Application.Index(TV, I) 'renvoie dans DEST redimensionnée la ligne I du tableau TV
            End If 'fin de la condition 2
        Next I 'prochaine ligne de la boucle 2
    End If 'fin de la condition 1
Next OS 'prochain onglet de la boucle 1
End Sub

Merci beaucoup....ça marche très très bien....vous m'avez rendu un grand grand service.. ça m'évitera de faire à chaque fois des copier coller des tableaux et les coller vers la feuille courrier