Macro repeter tant que en codage VBA

manzlem

XLDnaute Nouveau
Bonjour

Je souhaiterai solliciter votre aide puisque je dois realiser une boucle repeter tant que et que je ne pense pas avoir le niveau pour realiser celle ci.

Je dois copier coller des lignes depuis ma feuille 2 sur ma feuille 1.
Chaque ligne sur ma feuille 2 commence par la lettre S (numero de l objet, sa description...) et la lettre P qui contient toutes les informations sur la decoupe des objets a realiser.
Comme il est possible de faire plusieurs decoupes par objet il y a plus de ligne qui commence par P que par S mais celles-ci sont ordonnees de bas en haut.

Mon objectif serai de creer une boucle que copierai la ligne commencant par S en A1 par exemple puis de copier la ligne P a partir de A15 (car il y a 15 informations dans ma ligne S) et copier toutes les lignes P en dessous a la suite jusqu'a ce que la prochaine ligne soit un S. Et recommence cette boucle jusqu'a ce qu'il trouve une cellule vide dans la colonne A1 de la feuille2.

voici actuellement le code que j ai mis en place qui fonctionne pour une seule ligne.

HTML:
Sub Copy_Paste()
'
' Copy_Paste Macro
' Macro recorded 18/08/2015 by Miker
'
Dim plage As Range

Dim x As Long

Dim c



With Sheets("Sheet2")

    Set plage = .Range("A4:A" & .Range("C200").End(xlUp).Row)

    For Each c In plage

        If c.Value = "P" Or c.Value = "B" Then

            x = Sheets("Sheet1").Range("A200").End(xlUp).Row + 1
            ' 200 egale le nombre de ligne que l on veut
        
           c.EntireRow.Copy Sheets("Sheet1").Rows(x)

    
    ActiveCell.Range("B2") = "=MID(Sheet2!R1C3,1,1)"
    Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:P2"), Type:=xlFillDefault
    Range("B2:P2").Select
    Range("C2") = "=MID(Sheet2!R1C3,2,1)"
    Range("D2") = "=MID(Sheet2!R1C3,3,1)"
    Range("E2") = "=MID(Sheet2!R1C3,4,1)"
    Range("F2") = "=MID(Sheet2!R1C3,5,1)"
    Range("G2") = "=MID(Sheet2!R1C3,6,1)"
    Range("H2") = "=MID(Sheet2!R1C3,7,1)"
    Range("I2") = "=MID(Sheet2!R1C3,8,1)"
    Range("J2") = "=MID(Sheet2!R1C3,9,1)"
    Range("K2") = "=MID(Sheet2!R1C3,10,1)"
    Range("L2") = "=MID(Sheet2!R1C3,11,1)"
    Range("M2") = "=MID(Sheet2!R1C3,12,1)"
    Range("N2") = "=MID(Sheet2!R1C3,13,1)"
    Range("O2") = "=MID(Sheet2!R1C3,14,1)"
    Range("P2") = "=MID(Sheet2!R1C3,15,1)"
    Range("Q2") = "=MID(Sheet2!R1C4,1,1)"
    Range("Q2").Select
    Selection.AutoFill Destination:=Range("Q2:AT2"), Type:=xlFillDefault
    Range("Q2:AT2").Select
    Range("R2") = "=MID(Sheet2!R1C4,2,1)"
    Range("S2") = "=MID(Sheet2!R1C4,3,1)"
    Range("T2") = "=MID(Sheet2!R1C4,4,1)"
    Range("U2") = "=MID(Sheet2!R1C4,5,1)"
    Range("V2") = "=MID(Sheet2!R1C4,6,1)"
    Range("W2") = "=MID(Sheet2!R1C4,7,1)"
    Range("X2") = "=MID(Sheet2!R1C4,8,1)"
    Range("Y2") = "=MID(Sheet2!R1C4,9,1)"
    Range("Z2") = "=MID(Sheet2!R1C4,10,1)"
    Range("AA2") = "=MID(Sheet2!R1C4,11,1)"
    Range("AB2") = "=MID(Sheet2!R1C4,12,1)"
    Range("AC2") = "=MID(Sheet2!R1C4,13,1)"
    Range("AD2") = "=MID(Sheet2!R1C4,14,1)"
    Range("AE2") = "=MID(Sheet2!R1C4,15,1)"
    Range("AF2") = "=MID(Sheet2!R1C4,16,1)"
    Range("AG2") = "=MID(Sheet2!R1C4,17,1)"
    Range("AH2") = "=MID(Sheet2!R1C4,18,1)"
    Range("AI2") = "=MID(Sheet2!R1C4,19,1)"
    Range("AJ2") = "=MID(Sheet2!R1C4,20,1)"
    Range("AK2") = "=MID(Sheet2!R1C4,21,1)"
    Range("AL2") = "=MID(Sheet2!R1C4,22,1)"
    Range("AM2") = "=MID(Sheet2!R1C4,23,1)"
    Range("AN2") = "=MID(Sheet2!R1C4,24,1)"
    Range("AO2") = "=MID(Sheet2!R1C4,25,1)"
    Range("AP2") = "=MID(Sheet2!R1C4,26,1)"
    Range("AQ2") = "=MID(Sheet2!R1C4,27,1)"
    Range("AR2") = "=MID(Sheet2!R1C4,28,1)"
    Range("AS2") = "=MID(Sheet2!R1C4,29,1)"
    Range("AT2") = "=MID(Sheet2!R1C4,30,1)"
    Range("AU2") = "=MID(Sheet2!R2C4,1,1)"
    Range("AU3:AZ3").Select
    Range("AU2").Select
    Selection.AutoFill Destination:=Range("AU2:AZ2"), Type:=xlFillDefault
    Range("AU2:AZ2").Select
    Range("AV2") = "=MID(Sheet2!R2C4,2,1)"
    Range("AW2") = "=MID(Sheet2!R2C4,3,1)"
    Range("AX2") = "=MID(Sheet2!R2C4,4,1)"
    Range("AY2") = "=MID(Sheet2!R2C4,5,1)"
    Range("AZ2") = "=MID(Sheet2!R2C4,6,1)"
    Range("BA2") = "=MID(Sheet2!R3C4,1,1)"
    Range("BA2").Select
    Selection.AutoFill Destination:=Range("BA2:BF2"), Type:=xlFillDefault
    Range("BA2:BF2").Select
    Range("BB2") = "=MID(Sheet2!R3C4,2,1)"
    Range("BC2") = "=MID(Sheet2!R3C4,3,1)"
    Range("BD2") = "=MID(Sheet2!R3C4,4,1)"
    Range("BE2") = "=MID(Sheet2!R3C4,5,1)"
    Range("BF2") = "=MID(Sheet2!R3C4,6,1)"
    Range("BG2") = "=MID(Sheet2!R3C5,1,1)"
    Range("BG2").Select
    Selection.AutoFill Destination:=Range("BG2:BK2"), Type:=xlFillDefault
    Range("BG2:BK2").Select
    Range("BH2") = "=MID(Sheet2!R3C5,2,1)"
    Range("BI2") = "=MID(Sheet2!R3C5,3,1)"
    Range("BJ2") = "=MID(Sheet2!R3C5,4,1)"
    Range("BK2") = "=MID(Sheet2!R3C5,5,1)"
    Range("BL2") = "=MID(Sheet2!R3C6,1,1)"
    Range("BL2").Select
    Selection.AutoFill Destination:=Range("BL2:BP2"), Type:=xlFillDefault
    Range("BL2:BP2").Select
    Range("BM2") = "=MID(Sheet2!R3C6,2,1)"
    Range("BN2") = "=MID(Sheet2!R3C6,3,1)"
    Range("BO2") = "=MID(Sheet2!R3C6,4,1)"
    Range("BP2") = "=MID(Sheet2!R3C6,5,1)"
    Range("BQ2") = "=MID(Sheet2!R3C3,1,1)"
    Range("BQ2").Select
    Selection.AutoFill Destination:=Range("BQ2:BS2"), Type:=xlFillDefault
    Range("BQ2:BS2").Select
    Range("BR2") = "=MID(Sheet2!R3C3,2,1)"
    Range("BS2") = "=MID(Sheet2!R3C3,3,1)"
    Range("BQ3:BS3").Select
    Range("BY2") = "=MID(Sheet2!R3C2,1,1)"
    Range("BY2").Select
    Selection.AutoFill Destination:=Range("BY2:CC2"), Type:=xlFillDefault
    Range("BY2:CC2").Select
    Range("BZ2") = "=MID(Sheet2!R3C2,2,1)"
    Range("CA2") = "=MID(Sheet2!R3C2,3,1)"
    Range("CB2") = "=MID(Sheet2!R3C2,4,1)"
    Range("CC2") = "=MID(Sheet2!R3C2,5,1)"
    Range("BY3:CC3").Select
    Range("CI2") = "=MID(Sheet2!R3C17,1,1)"
    Range("CI2").Select
    Selection.AutoFill Destination:=Range("CI2:CU2"), Type:=xlFillDefault
    Range("CI2:CU2").Select
    Range("CJ2") = "=MID(Sheet2!R3C17,2,1)"
    Range("CK2") = "=MID(Sheet2!R3C17,3,1)"
    Range("CL2") = "=MID(Sheet2!R3C17,4,1)"
    Range("CM2") = "=MID(Sheet2!R3C17,5,1)"
    Range("CN2") = "=MID(Sheet2!R3C17,6,1)"
    Range("CO2") = "=MID(Sheet2!R3C17,7,1)"
    Range("CP2") = "=MID(Sheet2!R3C17,8,1)"
    Range("CQ2") = "=MID(Sheet2!R3C17,9,1)"
    Range("CR2") = "=MID(Sheet2!R3C17,10,1)"
    Range("CS2") = "=MID(Sheet2!R3C17,11,1)"
    Range("CT2") = "=MID(Sheet2!R3C17,1,1)"
    Range("CT2") = "=MID(Sheet2!R3C17,13,1)"
    Range("CU2") = "=MID(Sheet2!R3C17,14,1)"
    Range("CI3:CU3").Select
    
     
       End If

    Next c

End With



End Sub


Merci d'avance
 

Pièces jointes

  • Macro rapide.xls
    86 KB · Affichages: 42

Dranreb

XLDnaute Barbatruc
Re : Macro repeter tant que en codage VBA

Bonjour.

De toute façon ce n'est pas bon de faire des End(xlUp).Row + 1 à chaque passage dans une boucle. On en fait un au début pour savoir où il faut commencer à inscrire, mais après on l'incrémente simplement avant chaque ajout de ligne. Faites le avant de copier une ligne, qu'elle soit "S" ou "R". mais pour la "S", après copie, faites x = x - 1 (je préfèrerais L comme Ligne) afin de l'annuler pour que la copie de la 1ère "R" se fasse sur la même ligne.

Et travaillez plutot avec un tableaux VBA. Là écrit comme ça ce sera horriblement long à exécuter.
Trouvez des formules communes pour toute une plage horizontale:
VB:
Range("C2:P2").FormulaR1C1 = "=MID(Sheet2!R1C3,COLUMN()-1,1)"
 

manzlem

XLDnaute Nouveau
Re : Macro repeter tant que en codage VBA

Bonjour et merci de votre aide.

J'ai copier votre commande seulement elle ne descend pas de ligne et supperpose toutes les informations. J'ai vu que vous parler de x = x - 1 mais je ne sais pas ou l'inserer. Desoler je suis un debutant en VBA
 

Dranreb

XLDnaute Barbatruc
Re : Macro repeter tant que en codage VBA

Vous mettez une incrémentation devant l'insertion de toute les lignes, mais vous ajoutez cette décrémentation derrière l'insertion d'une "S" pour neutraliser l'incrémentation qui viendra pour la "R" suivante afin qu'elle s'inscrive sur la même ligne.
 

Statistiques des forums

Discussions
315 095
Messages
2 116 166
Membres
112 675
dernier inscrit
Tazra_IMOU