XL 2016 Recopier une cellule selon la valeur d'une autre

[Stefbarbu]

Bonjour,
j'ai besoin de votre aide 🙂

j’ai une liste de centre avec un nombre de contrats (Feuil1) et je voudrais copier le centre (Feuil2) le nombre de fois qu'il y a de contrats.
idéalement avec une macro.

Merci de votre aide

 

[Hasco]

Bonjour,

voici une macro qui fonctionne sur votre fichier

Sub Allonsy()
    Dim Centres As Variant
    Dim i As Integer
    With ThisWorkbook
        With .Sheets("Feuil1").Range("A1").CurrentRegion
            Centres = .Offset(1).Resize(.Rows.Count - 1, 2)
        End With
        With .Sheets("Feuil2")
            For i = 1 To UBound(Centres)
                .Cells(Rows.Count, 1).End(xlUp)(2).Resize(Centres(i, 2)) = Centres(i, 1)
            Next
        End With
    End With
End Sub

La prochaine fois que vous demanderez une macro, soyez gentil de mettre un fichier .xlsm en pièce jointe pas un .xlsx

cordialement

 

[Stefbarbu]

Bonjour Hasco,

désolé pour le format, je n'y avais pas penser.

merci pour le VB, je vais le tester

 

[Stefbarbu]

Bonjour Hasco,
j'ai adapté la macro à mon document et il y a quelque qui cloche

j'ai renommé les feuilles avec les noms respectifs des onglets
j'ai adapté le Range où il doit aller chercher les informations

mais il y a un message d'erreur dans le For ... Next

la macro est dans le module CDP_CTsuggérés

merci de votre aide.

 

[Hasco]

Re,

Il y a des choses qui ne peuvent pas se deviner.
C'est la raison pour laquelle on demande des exemples 'REPRESENTATIFS' de la réalité tant que faire se peut 🙂

J'ai utilisé .CurrentRegion (équivalent de vba pour CTRL+* sur une feuille de calcul) parce que le tableau de votre exemple était un tableau au sens stricte d'excel. A savoir une zone de cellules contigües entourée de lignes et colonnes vides. Ce n'est pas le cas dans votre dernier fichier. Qui plus est semblait non limité en lignes.

Faites CTRL+* sur D51 vous verrez la plage retournée par currentregion.

Votre plage source est fixe : référencez là de manière fixe :

Centres = .Sheets("Contrat Source").Range("D51:E59").Value

Et comme vous aurez des cellules sans nombre en colonnes 2 vous testez dans la boucle.

If Centres(i, 2) > 0 Then ...... End If

Sub Allonsy()
    Dim Centres As Variant
    Dim i As Integer
    With ThisWorkbook
        Centres = .Sheets("Contrat Source").Range("D51:E59").Value
        With .Sheets("Demande de Bus")
            For i = 1 To UBound(Centres)
             If Centres(i, 2) > 0 Then
                .Cells(Rows.Count, 1).End(xlUp)(2).Resize(Centres(i, 2)) = Centres(i, 1)
             End If
            Next
        End With
    End With
End Sub

Cordialement

 

[Stefbarbu]

je pensais que ça aurait été simple et facile à adapter !

un gros merci !

bonne journée