Copier Coller Colonnes selon Conditions

Bonjour,

Je suis nouveau sur ce forum car je rencontre actuellement un petit problème sur VBA.

J'ai une première feuille dans un classeur avec plusieurs colonnes (il s'agit de ma base de données). Dans ma deuxième feuille, j'ai listé tous les noms des colonnes par ordre alphabétique dans la colonne A.

L'idée serait de copier coller les colonnes dans une troisième feuille quand je mets un "X" dans la colonne B devant le nom de la colonnes.

Merci

Bonjour,

En remontant dans le forum, tu trouveras des problématiques très proches de la tienne. Pas plus tard qu'aujourd'hui : https://forum.excel-pratique.com/viewtopic.php?f=2&t=112465

Après avoir fais l'effort d'essayer de comprendre comment ça marche et si tu ne vois pas comment adapter ça a ton cas, redis-le.

Spoiler
Sub CopieConditionnelle()

    Dim Source As Worksheet, Destination As Worksheet, Base As Worksheet, Lig As Integer, MaxLig As Integer, Col As Integer, MaxCol As Integer, ColDest As Integer

    Set Source = Sheets("Feuil1") 'Onglet avec liste de tes colonnes
    Set Base = Sheets("BDD") 'Onglet Base de données complète
    Set Destination = Sheets("Feuil2") 'Onglet Base de données filtrée (=contenant seulement les colonnes à copier)

    MaxLig = Source.Cells(Rows.Count, 1).End(xlUp).Row
    MaxCol = Base.Cells(1, Columns.Count).End(xlToLeft).Column
    ColDest = Base.Cells(1, Columns.Count).End(xlToLeft).Column
    If ColDest = 1 Then ColDest = 0

    For Lig = 1 To MaxLig 'Boucle pour parcourir les lignes de la source
        If Source.Cells(Lig, 2).Value = "X" Then 'Vérification de la présence d'un X en seconde colonne
            For Col = 1 To MaxCol
                If Base.Cells(1, Col).Value = Source.Cells(Lig, 1).Value Then Exit For 'Si on trouve la bonne colonne, on sort de la boucle
                If Col = MaxCol Then 'Cas où on a tout parcouru sans rien trouver
                    Col = 0
                    MsgBox "Colonne " & Source.Cells(Lig, 1).Value & " non retrouvée"
                    Exit For
                End If
            Next Col
            If Col > 0 Then 'Si on a trouvé, copier la colonne
                ColDest = ColDest + 1  'Compteur de colonnes reportées dans l'onglet de destination
                Base.Columns(Col).Copy Destination.Colums(ColDest) 'Copier/coller la colonne entière
            End If
        End If
    Next Lig

End Sub

Et bien ce fut un plaisir d'échanger avec toi !

Merci Pedro22.

C'est exactement ce que je voulais.

Cependant au moment de coller les cellules dans la feuille 3 les colonnes commence à partir de la dernière colonne du ma base de données (par exemple dernière colonne dans ma base de données est la colonne R, dans ma feuille 3 les valeurs apparaissent dans la colonne R.)

J'ai pensé à faire un couper coller dans la colonne B mais ma base de données peut évoluer dans le temps.

Par ailleurs, j'aimerais rajouter une autre condition, à savoir la date.

Ma première colonne de la base de données est des dates.

J'aimerai dans ma feuille2 (Source) rajouter une date et je copie colle dans la feuille Destination à partir de cette Date.

Donc j'aurais dans ma colonne A les dates et à partir de la colonne B mes valeurs à partir de cette date.

Merci pour ton aide

Sub copieConditionnelle()

    Dim Source As Worksheet, Destination As Worksheet, Base As Worksheet, Lig As Integer, MaxLig As Integer, Col As Integer, MaxCol As Integer, ColDest As Integer
    Dim z As Integer
    Dim nbgraph

    Set Source = Sheets("Feuil2") 'Onglet avec liste de tes colonnes
    Set Base = Sheets("Feuil1") 'Onglet Base de données complète
    Set Destination = Sheets("Feuil3") 'Onglet Base de données filtrée (=contenant seulement les colonnes à copier)

    Destination.Range("B1").End(xlDown).End(xlToLeft).ClearContents

    nbgraph = ActiveSheet.ChartObjects.Count 'Supprimer courbes
    If nbgraph > 0 Then
        For z = 1 To nbgraph
        Destination.ChartObjects(z).Delete
        Next z
    End If

    MaxLig = Source.Cells(Rows.Count, 1).End(xlUp).Row
    MaxCol = Base.Cells(1, Columns.Count).End(xlToLeft).Column
    ColDest = Base.Cells(1, Columns.Count).End(xlToLeft).Column
    If ColDest = 1 Then ColDest = 0

    For Lig = 1 To MaxLig 'Boucle pour parcourir les lignes de la source
    If Source.Cells(Lig, 2).Value = "X" Then 'Vérification de la présence d'un X en seconde colonne
            For Col = 1 To MaxCol
            If Base.Cells(1, Col).Value = Source.Cells(Lig, 1).Value Then Exit For 'Si on trouve la bonne colonne, on sort de la boucle
                If Col = MaxCol Then 'Cas où on a tout parcouru sans rien trouver
                    Col = 0
                    MsgBox "Colonne " & Source.Cells(Lig, 1).Value & " non retrouvée"
            Exit For
    End If
            Next Col
            If Col > 0 Then 'Si on a trouvé, copier la colonne
                ColDest = ColDest + 1  'Compteur de colonnes reportées dans l'onglet de destination
                Base.Columns(Col).Copy Destination.Columns(ColDest) 'Copier/coller la colonne entière
            End If
        End If
    Next Lig
    Destination.Range("A1").Select
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("Feuil3!A1:BZ60000")
End Sub

Bonjour,

Pour ta première remarque, j'ai fait une petite erreur :

Sub copieConditionnelle()

    Dim Source As Worksheet, Destination As Worksheet, Base As Worksheet, Lig As Integer, MaxLig As Integer, Col As Integer, MaxCol As Integer, ColDest As Integer
    Dim z As Integer
    Dim nbgraph

    Set Base = Sheets("Feuil1") 'Onglet Base de données complète
    Set Source = Sheets("Feuil2") 'Onglet avec liste de tes colonnes
    Set Destination = Sheets("Feuil3") 'Onglet Base de données filtrée (=contenant seulement les colonnes à copier)

    Destination.Range("B1").End(xlDown).End(xlToLeft).ClearContents

    nbgraph = ActiveSheet.ChartObjects.Count 'Supprimer courbes
    If nbgraph > 0 Then
        For z = 1 To nbgraph
        Destination.ChartObjects(z).Delete
        Next z
    End If

    MaxLig = Source.Cells(Rows.Count, 1).End(xlUp).Row
    MaxCol = Base.Cells(1, Columns.Count).End(xlToLeft).Column
    ColDest = Destination.Cells(1, Columns.Count).End(xlToLeft).Column 'Erreur ici, la feuille concernée est "Destination"
    If ColDest = 1 Then ColDest = 0 'PS, pour ne pas tenir compte de la présence éventuelle de données en feuille "Destination", supprimer cette ligne et la précédente et faire un simple ColDest = 0

    For Lig = 1 To MaxLig 'Boucle pour parcourir les lignes de la source
    If Source.Cells(Lig, 2).Value = "X" Then 'Vérification de la présence d'un X en seconde colonne
            For Col = 1 To MaxCol
            If Base.Cells(1, Col).Value = Source.Cells(Lig, 1).Value Then Exit For 'Si on trouve la bonne colonne, on sort de la boucle
                If Col = MaxCol Then 'Cas où on a tout parcouru sans rien trouver
                    Col = 0
                    MsgBox "Colonne " & Source.Cells(Lig, 1).Value & " non retrouvée"
            Exit For
    End If
            Next Col
            If Col > 0 Then 'Si on a trouvé, copier la colonne
                ColDest = ColDest + 1  'Compteur de colonnes reportées dans l'onglet de destination
                Base.Columns(Col).Copy Destination.Columns(ColDest) 'Copier/coller la colonne entière
            End If
        End If
    Next Lig
    Destination.Range("A1").Select
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range("Feuil3!A1:BZ60000")
End Sub

Pour la seconde partie de ta question, je vais te laisser modifier le code par toi même. Il faut que ta colonne 1 soit copiée dans tout les cas, mais cette fois on ne copie plus une colonne entière (".Colums(Col).Copy") mais :

  • -> Possibilité1 : seulement une plage (".Range(.Cells(LigneDébut, Col), .Cells(LigneFin, Col)).Copy") - /!\ pour des dates triées par ordre croissant
  • -> Possibilité2 : pas de copie (.Copy) mais on reporte les valeurs cellule par cellule à partir d'une ligne de départ (1ère date concernée) jusqu'à la dernière ligne. Il te faut donc une nouvelle boucle qui parcours les lignes et affecte les valeurs ("Destination.Cells(i, ColDest).Value = Base.Cells(i, Col).Value").

Donc :

  • -> Dans tous les cas, il faudra réfléchir comment écrire ça pour éviter d'avoir un grand espace vide en feuille "Destination" pour toutes les lignes non copiées...
  • -> La première étape consiste à récupérer la date mini et identifié la première ligne la contenant
Rechercher des sujets similaires à "copier coller colonnes conditions"