Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Macro repeter tant que en codage VBA

M

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
Trier par date Trier par votes

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)"
 
Vote positif 0 Vote négatif
M

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
 
Vote positif 0 Vote négatif

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.
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Question
XL 2019 Ajouter un " aperçu avant impression " à ce code
Réponses
7
Affichages
832
Yann71
B
  • Résolu(e)
XL 2016 macro avec boucle
2
Réponses
16
Affichages
2 K
benbella1991
B
M
  • Question
Microsoft 365 Formule trop longue ?
2 3
Réponses
40
Affichages
3 K
moanin
M
R
  • Question
XL 2019 Macro VBA autofill à partir de la première cellule vide du tableauRépondre
Réponses
2
Affichages
954
Hasco
  • Résolu(e)
XL 2016 Incrementer une colonne en VBA
Réponses
4
Affichages
1 K
Patrice33740
G
  • Question
XL 2013 Figer les valeurs après macro
Réponses
3
Affichages
1 K
danielco
D
D
  • Question
XL 2013 Macro VBA conversion fichier tsv en csv
2
Réponses
22
Affichages
3 K
Robert
C
  • Question
XL 2016 VBA macro affectée à une sélection
Réponses
5
Affichages
818
cardi
C
B
  • Question
XL 2016 Formule excel en VBA ?
Réponses
13
Affichages
1 K
Barazouti
B
  • Question
XL 2010 Simplifier une macro
Réponses
3
Affichages
868
vgendron
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…