[VBA] Copier une colonne si la valeur en-tête = valeur selectionnée

Bonsoir,

J'espère que vous allez bien.

Je suis à la recherche de quelques conseils pour terminer une macro VBA sur Excel.

Voici un fichier de prévision de ventes par articles par semaine.

Sur ce fichier, j'ai créé un formulaire sur lequel il est possible de choisir un numéro de semaine.

Le but étant de copier la liste de mes produits, puis les données de la semaine correspondante dans un nouvel onglet

Objectifs :

1. Sélection de mes produits et copie sur un nouvel onglet (Depuis A11, jusqu'en bas)
2. Recherche de la valeur sélectionnée dans le formulaire (Dans mes semaines - colonnes d'en-tête)
3. Si la valeur est trouvée, alors copie des valeurs se situant en dessous, puis copie dans mon nouvel onglet à coté de mes produits

Voici le code actuel :

Private Sub Extract_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Dim wbsos As Workbook
    Dim Sos As Worksheet
    Dim WeekNo As Range
    Dim Nbcol As Long
    Dim ColActive As Long

        'affectation des variables
        Set wbsos = ThisWorkbook
        Set Sos = wbsos.Sheets("Sales")

            'selection et copie de la liste des produits
            Sos.Activate
            Range("A11").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            Sheets.Add
            ActiveSheet.Name = "Forecast"
            Set forc = wbsos.Sheets("Forecast")
            ActiveCell.Offset(1, 0).PasteSpecial

                'Affectation des variables et du nombre de colonne
                Sos.Activate
                Set WeekNo = Sos.Range("HC10", Sos.Range("HC10").End(xlToRight))
                Nbcol = WeekNo.Columns.Count
                Nbcol = 0

                    'Boucle sur les colonnes de semaine
                    For Each WeekNo In Nbcol

            'si la valeur de la colonne est équivalente à la selection du formulaire alors copie dans le nouvel onglet
            If Me.cbWeekno = WeekNo.Value Then
            WeekNo.EntireColumn.Copy forc.Range("B2")
            End If

        Next

End Sub

Le fichier :

Problème :

Je n'arrive pas à trouver une boucle me permettant de selectionner la colonne si la valeur est trouvée.

Est-ce faisable à votre avis ?

J'apprécierai grandement votre aide.

Merci,

bonsoir,

une proposition de corrections + adaptations :

Private Sub Extract_Click()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim wbsos As Workbook
    Dim Sos As Worksheet
    Dim WeekNo As Range, WeekRange As Range
    Dim Nbcol As Long, dl As Long
    Dim ColActive As Long

    'affectation des variables
    Set wbsos = ThisWorkbook
    Set Sos = wbsos.Sheets("Sales")

    'selection et copie de la liste des produits
    With Sos
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range("A11:A" & dl).Copy
        Sheets.Add
        ActiveSheet.Name = "Forecast"
        Set forc = ActiveSheet
        forc.Range("A2").PasteSpecial

        'Affectation des variables et du nombre de colonne
        Set WeekRange = .Range("HC10", .Range("HC10").End(xlToRight))

        'Boucle sur les colonnes de semaine
        For Each WeekNo In WeekRange

            'si la valeur de la colonne est équivalente à la selection du formulaire alors copie dans le nouvel onglet
            If Me.cb_WeekNo = WeekNo.Value Then
                .Cells(1, WeekNo.Column).Resize(dl, 1).Copy forc.Range("B2")
                Exit For
            End If

        Next
    End With
End Sub

Bonjour h2so4,

Merci pour ta contribution, la correction apportée me permet de faire les actions demandées.

Pour toi quel était le problème de cette macro ?

Très belle journée à toi,

GalileeO

bonjour,

j'ai mis des commentaires pour mettre en avant les erreurs que j'ai corrigées.

Private Sub Extract_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

    Dim wbsos As Workbook
    Dim Sos As Worksheet
    Dim WeekNo As Range
    Dim Nbcol As Long
    Dim ColActive As Long

        'affectation des variables
        Set wbsos = ThisWorkbook
        Set Sos = wbsos.Sheets("Sales")

            'selection et copie de la liste des produits
            Sos.Activate
            Range("A11").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            Sheets.Add
            ActiveSheet.Name = "Forecast"
            Set forc = wbsos.Sheets("Forecast")
            ActiveCell.Offset(1, 0).PasteSpecial

                'Affectation des variables et du nombre de colonne
                Sos.Activate
                Set WeekNo = Sos.Range("HC10", Sos.Range("HC10").End(xlToRight))
                Nbcol = WeekNo.Columns.Count 'nombre de colonnes
                Nbcol = 0 'nbcol=0 ! ceci annule l'instruction précédente

                    'Boucle sur les colonnes de semaine
                    For Each WeekNo In Nbcol '<- problème ici, for each est utilisé pour boucler sur une collection ou un tableau or nbcol est une variable de type long.

            'si la valeur de la colonne est équivalente à la selection du formulaire alors copie dans le nouvel onglet
            If Me.cbWeekno = WeekNo.Value Then 'erreur ici c'est cb_weekno et non cbweekno
            WeekNo.EntireColumn.Copy forc.Range("B2") 'erreur ici on ne peut pas copier toute une colonne et la coller à partir de la ligne 2, pas de place pour toute la colonne...
            End If

        Next

End Sub

C'est vraiment super, merci beaucoup pour le geste !

Bonjour,

J'ai deux autres questions :

1 - Pour les semaines non-écoulées, les cellules des colonnes à sélectionner renvoient à des formules.

• Comment copier uniquement les valeurs des cellules ?

2- Est-il possible de ne sélectionner qu'une partie de la colonne WeekNo :

            If Me.cb_WeekNo = WeekNo.Value Then
                .Cells(1, WeekNo.Column).Resize(dl, 1).Copy forc.Range("B2")
                Exit For
            End If

J'ai besoin de me débarrasser des premières données de la colonne ("B2:B11), afin que les prévisions soient en face des produits.

Je vous remercie,

GalileOO

bonjour,

réponse à tes 2 questions

   If Me.cb_WeekNo = WeekNo.Value Then
                forc.Range("B2").Resize(dl, 1).Value = .Cells(11, WeekNo.Column).Resize(dl, 1).Value
                Exit For
            End If

C'est exactement ce qu'il me faut.

Encore un grand merci à vous!

Bonjour le Forum, Bonjour à tous,

J'aimerais trouver une modification du code VBA ci-dessus, je patauge un peu dans la marre VBA, c'est encore une peu plus technique.

Rappel : Sur ce fichier, j'ai créé un formulaire sur lequel il est possible de choisir un numéro de semaine.

En effet, mon besoin de départ était de copier ma colonne Produits/Item_ID (Sales : A1 : A172) à côté des données de la semaine sélectionnée dans mon formulaire --> Dans un nouvel onglet "Forecast

Merci H2so4 pour la résolution !

Aujourd'hui, mon besoin est différent , il faut que je programme :

1. Recherche de la valeur sélectionnée dans le formulaire (Dans mes semaines - colonnes d'en-tête)
2. Si la valeur trouvée est supérieure ou égale à la valeur sélectionnée dans le formulaire alors,
3. Je copie tous les produits et les prévisions-semaine correspondantes dans la même colonne semaine après semaine
   
   1. Produits : Destination = Onglet "Forecast" Colonne A (toujours la même liste)
   2. Prévisions : Destination = Onglet "Forecast" Colonne B (les prévisions/semaine restantes dans la même colonne en face de leurs produits)
   3. WeekNo.value : Destination = Onglet "Forecast" Colonne C : La valeur du numéro de semaine à droite du produit + prévisions

Voici le code actuel :

Private Sub Extract_Click()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim wbsos As Workbook
    Dim Sos As Worksheet
    Dim Param As Worksheet
    Dim WeekNo As Range, WeekRange As Range
    Dim Nbcol As Long, dl As Long
    Dim ColActive As Long
    Dim i As Long
    Dim prod As Long

    'affectation des variables
    Set wbsos = ThisWorkbook
    Set Sos = wbsos.Sheets("Sales")
    Set Param = wbsos.Sheets("Parameters")

    'selection et copie de la liste des produits
    With Sos
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range("A11:A" & dl).Copy
        Sheets.Add
        ActiveSheet.Name = "Forecast"
        Set forc = ActiveSheet
        forc.Range("A2").PasteSpecial

    'Affectation des variables et du nombre de colonne
    Set WeekRange = .Range("HC10", .Range("HC10").End(xlToRight))

    'Boucle sur les colonnes de semaine
    For Each WeekNo In WeekRange

        'si la valeur de la colonne est équivalente à la selection du formulaire alors copie dans le nouvel onglet
         If Me.cb_WeekNo = WeekNo.Value Then
            forc.Range("B2").Resize(dl, 1).Value = .Cells(11, WeekNo.Column).Resize(dl, 1).Value
            Param.Range("E2").Value = WeekNo.Value
            Exit For
        End If

        Next
    End With

Le fichier :

Comment puis-je boucler ce paramètre ?

Merci d'avance,

GalileOO

Rebonjour,

J'ai essayé la formule suivante et cela ne marche pas :

Private Sub Extract_Click()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim wbsos As Workbook
    Dim Sos As Worksheet
    Dim Param As Worksheet
    Dim WeekNo As Range, WeekRange As Range
    Dim Nbcol As Long, dl As Long, dc As Long
    Dim ColActive As Long
    Dim i As Long
    Dim prod As Long

    'affectation des variables
    Set wbsos = ThisWorkbook
    Set Sos = wbsos.Sheets("Sales")
    Set Param = wbsos.Sheets("Parameters")

    'selection et copie de la liste des produits
    With Sos
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range("A11:A" & dl).Copy
        Sheets.Add
        ActiveSheet.Name = "Forecast"
        Set forc = ActiveSheet
        forc.Range("A2").PasteSpecial

    'Affectation des variables et du nombre de colonne
    Set WeekRange = .Range("HC10", .Range("HC10").End(xlToRight))

    'Boucle sur les colonnes de semaine
    For Each WeekNo In WeekRange

        'si la valeur de la colonne est équivalente à la selection du formulaire alors copie dans le nouvel onglet
         If Me.cb_WeekNo = WeekNo.Value Then
            dc = WeekNo.Cells(1, Columns.Count).End(xlToRight).Column
            forc.Range("B2").Resize(dl, 1).Value = .Range("H" & WeekNo.Column, "H" & dc).Value
            Param.Range("E2").Value = WeekNo.Value
            Exit For
        End If

        Next

J'ai essayé de partir du if pour partir de la bonne semaine (la semaine selectionnée dans le formulaire)

Puis de définir les semaines restantes grâce à Columns.count

Pour ensuite l'intégrer dans ma plage à copier

Sans succès.

Qqn a t-il une idée ?

Merci d'avance,

GalileeO

bonjour,

voici, si j'ai bien lu ta demande.

Private Sub Extract_Click()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim wbsos As Workbook
    Dim Sos As Worksheet
    Dim WeekNo As Range, WeekRange As Range
    Dim Nbcol As Long, dl As Long
    Dim ColActive As Long

    'affectation des variables
    Set wbsos = ThisWorkbook
    Set Sos = wbsos.Sheets("Sales")

    'selection et copie de la liste des produits
    With Sos
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range("A11:A" & dl).Copy
        Sheets.Add
        ActiveSheet.Name = "Forecast"
        Set forc = ActiveSheet
        forc.Range("A2").PasteSpecial

        'Affectation des variables et du nombre de colonne
        Set WeekRange = .Range("HC10", .Range("HC10").End(xlToRight))

        'Boucle sur les colonnes de semaine
        For Each WeekNo In WeekRange

            'si la valeur de la colonne est équivalente à la selection du formulaire alors copie dans le nouvel onglet
            If Me.cb_WeekNo = WeekNo.Value Then
                forc.Range("B2").Resize(dl, WeekRange.Columns.Count).Value = .Cells(11, WeekNo.Column).Resize(dl, WeekRange.Columns.Count).Value
                Exit For
            End If

        Next

    End With
End Sub

Bonjour H20S4,

Merci pour ton aide, c'est bien ce que j'attendais.

GalileeO