VBA - Copier des plages de cellules les uns après les autre

Bonjour;

Je débute tout juste avec VBA, et je voudrais pouvoir copier des plages de cellule les unes après les autres, en fonction de condition. Je viens donc faire appel à l'aide, car après quelques heures de tentative, je n'ai pas trouvé qqchose que je sois en mesure d'adapter.

La commande s’exécute avec un bouton Controle Active X.

  • Si F92=0 rien, SI F92=1 Copy BJ99:BJ119 en E99, SI F92=2 Copy BI99:BJ119 en E99 (jusque là c'est bon)
  • Si H92=1 Copy BP99:BP119, SI H92 =2 Copy BO99:BP119; Si H92 = 3 Copy BN99:BP119, Si H92=4 Copy BM99:BP119, Si H92=5 Copy BL99:BP119, Si H92 = 6, Copy BK99:BP119 (Ce bloc doit donc se rajouter juste après la copy effectué en E99, et sur la ligne 99)
  • Si J92= 1 Copy BS99:BS119, Si J92= 2 Copy BR99:BS119 Si J92=3 BQ99:BS119 (Pareil)
  • Si L92 = 1 Copy BU99:BU119 ; Si L92 = 2 Copy BR99:BU119 (Pareil)
  • Si N92 = 2 Copy BY99:BZ119; Si N92 = 3 Copy BX99:BZ119; Si N92 = 4 Copy BW99:BZ119; Si N92 = 5 Copy BV99:BZ119; (Pareil)
  • SI P92 = 1 Copy CB99:CB119, Si P92 = 2 Copy CA99:CB119 (Pareil)
  • SI R92 = 1 Copy CD99:CD119, SI R92= 2 Copy CC99:CD119 (Pareil)

Puis pour finir rajouter en fin, la copy de CE99:CF119

Pour le moment j'ai ça comme code pour l'executer :

Private Sub Valider_Click() '<<----------------------------------------------------------- bouton pour saisie du calendrier
Range("E98:Z119").Clear '<<--------------------------------------------------------------------- Periode 1
If Range("F92").Value = 1 Then
Range("BJ99:BJ120").Copy
Range("E98").PasteSpecial (xlPasteAll)
End If
If Range("F91").Value = 2 Then
Range("BI99:BJ120").Copy
Range("E98").PasteSpecial (xlPasteAll)
End If

S'il vous plait est-ce que quelqu'un pourrait m'aider?

Merci déjà d'avoir pris le temps de me lire et j'espère vous lire à mon tour rapidement

Cheers!

Bonjour chrisla

Serait-il possible de joindre un fichier pour t'aider au mieux ?

Bonjour,

Salut matinal à BCC1701 !

Tu nous joues De l'art d'individualiser un max pour rendre le code plus long et plus complexe !

Il reste quelques régularités qui ont dû t'échapper !

Je l'ai pris comme exercice de mise en route au petit déjeuner (je sais, il est midi ! mais on m'a réveillé tardivement ! sinon je dormirais peut-être encore...)

On peut faire un petit peu mieux que ci-dessous, mais c'est ça c'est à un autre moment où je suis un peu plus aiguisé...

Function CorrespCol(k As Integer) As Integer
    Select Case k
        Case 6: CorrespCol = 62
        Case 8: CorrespCol = 68
        Case 10: CorrespCol = 71
        Case 12: CorrespCol = 73
        Case 14: CorrespCol = 78
        Case 16: CorrespCol = 80
        Case 18: CorrespCol = 82
    End Select
End Function

Sub Test()
    Dim k%, pk%, kc%
    pk = 5
    Application.ScreenUpdating = False
    With ActiveSheet
        For k = 6 To 18 Step 2
            Select Case .Cells(92, k)
                Case 1
                    If k <> 14 Then
                        kc = CorrespCol(k)
                        .Cells(99, pk).Resize(21, 1).Value = .Cells(99, kc).Resize(21, 1).Value
                        pk = pk + 1
                    End If
                Case 2
                    kc = CorrespCol(k) - 1
                    .Cells(99, pk).Resize(21, 2).Value = .Cells(99, kc).Resize(21, 2).Value
                    pk = pk + 2
                Case 3
                    If k = 8 Or k = 10 Or k = 14 Then
                        kc = CorrespCol(k) - 2
                        .Cells(99, pk).Resize(21, 3).Value = .Cells(99, kc).Resize(21, 3).Value
                        pk = pk + 3
                    End If
                Case 4
                    If k = 8 Or k = 14 Then
                        kc = CorrespCol(k) - 3
                        .Cells(99, pk).Resize(21, 4).Value = .Cells(99, kc).Resize(21, 4).Value
                        pk = pk + 4
                    End If
                Case 5
                    If k = 8 Or k = 14 Then
                        kc = CorrespCol(k) - 4
                        .Cells(99, pk).Resize(21, 5).Value = .Cells(99, kc).Resize(21, 5).Value
                        pk = pk + 5
                    End If
                Case 6
                    If k = 8 Then
                        kc = CorrespCol(k) - 5
                        .Cells(99, pk).Resize(21, 6).Value = .Cells(99, kc).Resize(21, 6).Value
                        pk = pk + 6
                    End If
            End Select
        Next k
    End With
End Sub

La fonction renvoie la colonne source du transfert pour la valeur 1, la proc. la rajuste selon la valeur...

Je ne garantirai pas que ce soit exempt d'erreur (pas testé), surtout au démarrage pour moi... mais si tu comprends le principe tu pourras rectifier les erreurs !

Cordialement.

(..)

@Mferrand

Bravo... J'ai l'impression que cette grasse matinée a été bénéfique

Par contre "Kossa l'ariv aou ?"

MFerrand a écrit :

Salut matinal à BCCNCC 1701

Bonjour NNC1701, Bonjour MFerrand,

Déjà merci de vos interventions.

@MFerrand : J'ai copié votre suggestion, qui n'a pas l'air de fonctionner, (rien ne se passe) et je ne comprends que très, très très vraguement sont fonctionnement. Petite question, il n'y a pas l'air d'y avoir de partie pour activer par le cliquage sur le bouton, c'est normal? Sinon le café a t il aidé?

@NNC1701 : Je joins le fichier, mais le code est un bordel sans nom ! J'avais fait plein de truc, mais comme un con, j'ai inséré des lignes sur ma sheet et du coup, tout s'est décalé. Et comme c'est ultra long, j'ai prévu de changer toute les "coordonnées" à la fin.

15chrisla-v2.xlsm (120.46 Ko)

Re ! (Après douche cette fois ! )

Excuses d'abord à NCC1701 : ne pas me tenir rigueur... mes doigts n'étaient pas encore ajustés au clavier.

Cela a pu se produire aussi dans le code ! Ce pourquoi si le résultat n'est pas celui attendu, vérifier les numéros de colonnes...

Christa :

Le bouton, pas bien compris ce dont il était question, mais c'est toi qui le place et qui y affecte la macro...

La macro elle-même se place normalement dans un module standard...

Pas vraiment le temps de voir ton fichier, mais je peux expliquer la méthode :

-D'abord le principe d'affectation des valeurs d'une plage source à une plage cible :

Les plages sont définies par CelluleSupérieureGauche.Resize(NbDeLignes, NbDeColonnes) [Resize permet de redimensionner...]

Selon tes indications le nombre de lignes est constant, 21 (lignes 99 à 119) et le nb de colonnes varie de 1 à 6 selon valeur en ligne 92.

L'affectation des valeurs se fait par : PlageCible.Value = PlageSource.Value.

(Pas de copier-coller, c'est plus rapide...)

-La variable k est destinée à boucler sur tes colonnes de la ligne 92, de F à R (soit 6 à 18), avec un pas de 2 [une régularité restante qui permet de boucler sans souci].

A chaque tour de boucle, en rapport avec la cellule testée et sa valeur il faut déterminer la colonne source associée : on la recueille dans la variable kc (cela aurait dû être plutôt ks, col. source plutôt que cible, mais j'étais pas encore assez clair ! , aucune importance si la valeur récupérée est bien la bonne...) On utilise une fonction pour renvoyer cette valeur (numéro de colonne source associé à chaque cellule ligne 92 lorsqu'il n'y a qu'une colonne à transférer, s'il y en a plus [valeur de la cellule >1] on décale vers la gauche [-1 si valeur=2, -2 si valeur=3... -5 si valeur=6]).

Il nous faut également connaître la colonne cible à servir, on la suit avec la variable pk [pour première col. !] que l'on initialise à 5 (col. E) selon tes indications, et après chaque affectation on incrémentera la variable du nombre de colonnes servies pour le prochain tour.

-Revenons à la procédure : on initialise donc pk, on inhibe la mise à jour de l'affichage (pour plus de rapidité), et on initie une boucle k de 6 à 18 (pas=2) qui va permettre de boucler tour à tour sur les cellules (ligne 92) contenant le nombre de colonnes à prélever.

Le nombre à prendre en considération pouvant varier de 1 à 6, on utilise un Select Case pour traiter le cas correspondant à la valeur trouvée.

Chaque cellule ne pouvant contenir que certaines de ces valeurs prédéfinies à prendre en compte, on cible le traitement pour les cellules concernées (conditions If, sauf pour le cas 2, valeur possible pour toutes les cellules, qui constitue un test supplémentaire...)

Le reste coule de source, dans chaque cas on détermine kc en appelant la fonction et en corrigeant le renvoi en fonction du cas, disposant alors de pk (première colonne plage cible) et de kc (première colonne plage source), connaissant la première ligne (99 pour les deux), on peut opérer l'affectation, et conclure le cas en incrémentant pk.

Cordialement.

Rechercher des sujets similaires à "vba copier plages uns"