Cellule bloquée VBA
Résolu
farreneit
Messages postés
280
Date d'inscription
Statut
Membre
Dernière intervention
-
farreneit Messages postés 280 Date d'inscription Statut Membre Dernière intervention -
farreneit Messages postés 280 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
Je suis actuellement en train de me créer un fichier d'automatisation sur Excel.
Toutefois, je bloque depuis plusieurs jours sur une partie.
Je souhaiterais créer une macro qui selectionne toutes les lignes du tableau où la dernière colonne possède un "!", qui les copie, les colle à la suite en remplacant le "!" par "003".
Attention, il faut que cela selectionne UNIQUEMENT les lignes où la dernière ligne possède un "!", peu importe le nombre de ligne qu'il y a (cela peu varier). Ainsi, il doit être possible de lancer 2x la macro d'affilés.
Le résultat que j'ai réussi à avoir est ci-dessous :
Toutefois, seulement la première ligne est copiée et non une ligne après l'autre. Ainsi, dans la colonne couleur, les bonnes valeurs ne sont pas copiées.
Ci-joint la macro correspndante :
N'hésitez pas à me demander si vous avez besoin d'informations supplémentaires ou si vous voulez recevoir le fichier.
Merci d'avance !
Cordialement,
farreneit
Je suis actuellement en train de me créer un fichier d'automatisation sur Excel.
Toutefois, je bloque depuis plusieurs jours sur une partie.
Je souhaiterais créer une macro qui selectionne toutes les lignes du tableau où la dernière colonne possède un "!", qui les copie, les colle à la suite en remplacant le "!" par "003".
Attention, il faut que cela selectionne UNIQUEMENT les lignes où la dernière ligne possède un "!", peu importe le nombre de ligne qu'il y a (cela peu varier). Ainsi, il doit être possible de lancer 2x la macro d'affilés.
Le résultat que j'ai réussi à avoir est ci-dessous :
Toutefois, seulement la première ligne est copiée et non une ligne après l'autre. Ainsi, dans la colonne couleur, les bonnes valeurs ne sont pas copiées.
Ci-joint la macro correspndante :
Dim Counter
Counter = 0
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=IF(R2C6=""!"",R2C1,"""")"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=IF(R2C6=""!"",R2C2,"""")"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=IF(R2C6=""!"",R2C3,"""")"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=IF(R2C6=""!"",R2C4,"""")"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=IF(R2C6=""!"",R2C5,"""")"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=IF(R2C6=""!"",""003"","""")"
Range("A1").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
While Counter < Range("compteur.de.pointexcla").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.paste
Counter = Counter + 1
Wend
N'hésitez pas à me demander si vous avez besoin d'informations supplémentaires ou si vous voulez recevoir le fichier.
Merci d'avance !
Cordialement,
farreneit
2 réponses
-
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 588
bonjour, je suggère ceci:Dim cl As Range, derlig As Long, lig As Long, nouvcel As Range Set cl = [A2] derlig = cl.End(xlDown).Row Set nouvcel = Cells(derlig + 1, 1) For lig = 2 To derlig If cl.Offset(, 5) = "!" Then cl.Resize(, 5).Copy nouvcel.Resize(, 5) nouvcel.Offset(, 5) = "'003" Set nouvcel = nouvcel.Offset(1) End If Set cl = cl.Offset(1) Next lig-
-
Cela fonctionne parfaitement !
Vous avez trouvé en 5 petites minutes ce que je recherche depuis plusieurs heures ..
Pourriez-vous me donner une explication très rapide du fonctionnement de cette macro s'il vous plait ?
Encore merci !Option Explicit Private Sub yyy() Dim cl As Range, derlig As Long, lig As Long, nouvcel As Range Set cl = [A2] ' cellule en A2 derlig = cl.End(xlDown).Row ' numéro de la dernière ligne à traiter Set nouvcel = Cells(derlig + 1, 1) ' position où insérer une nouvelle ligne For lig = 2 To derlig 'travaillons sur toutes les lignes à traiter If cl.Offset(, 5) = "!" Then ' vérifions le contenu décalé à droite de 5 colonnes cl.Resize(, 5).Copy nouvcel.Resize(, 5) ' recopions 5 colonnes vers la position où insérer nouvcel.Offset(, 5) = "'003" Set nouvcel = nouvcel.Offset(1) 'décalons la ligne où insérer d'une ligne vers le bas End If Set cl = cl.Offset(1) 'décalons la ligne à traiter d'une ligne vers le bas Next lig End Sub- Très complexe pour moi !
J'étais en train de faire un système de boucles et de copiés collés.
Merci beaucoup !!
Très bonne soirée !
-
-
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 588
bonjour, c'est, bien sûr, plus simple si tu partages le fichier, cela nous évite de recréer un exemple.-
Bonjour,
Merci pour votre réponse.
Il n'est à ma connaissance pas possible d'insérer un ficher dans le message ..
Si vous m'envoyez un mail je peux vous l'envoyer.
Merci !- pour partager ici un fichier, il suffit de publier le fichier sur internet (google drive, one drive, cjoint.com, ...), puis de partager ici le lien vers le fichier.
-
quand tu utilises les balises de code pour partager du VBA, peux-tu préciser le langage "basic"? merci!
- Désolé, ca sera fait la prochaine fois !
Voici :Dim Counter Counter = 0 Range("A1").Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Range("A1").Select ActiveCell.FormulaR1C1 = "=IF(R2C6=""!"",R2C1,"""")" ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.FormulaR1C1 = "=IF(R2C6=""!"",R2C2,"""")" ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.FormulaR1C1 = "=IF(R2C6=""!"",R2C3,"""")" ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.FormulaR1C1 = "=IF(R2C6=""!"",R2C4,"""")" ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.FormulaR1C1 = "=IF(R2C6=""!"",R2C5,"""")" ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.FormulaR1C1 = "=IF(R2C6=""!"",""003"","""")" Range("A1").Select Selection.End(xlDown).Select Range(Selection, Selection.End(xlToRight)).Select Selection.Copy While Counter < Range("compteur.de.pointexcla").Value ActiveCell.Offset(1, 0).Range("A1").Select ActiveSheet.paste Counter = Counter + 1 Wend
-
