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

Macro

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion ana
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
A

ana

Guest
bonjour,
j'ai perdu des données dans un tableau !
Dans ma feuille1 lorsque je mets une croix, ça me crée une ligne dans ma feuille "cotation".
Mon problème est qu'au final je n'ai pas le même nombre de croix que de lignes.

Est-il possible d'avoir un bouton (Macro) qui me scan toutes la plages des croix et sur une nouvelle feuille "récap" me recrée toutes les lignes ?

Voici la Macro que j'utilise pour créer les lignes en fonction des croix tapées.

Merci d'avance pour votre aide,
A.

------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Application.EnableEvents = False
If Not Intersect(Target, Range("I2:AL30000")) Is Nothing Then
If Target = "" Then
Target = "X"
'Worksheet_Change Target
Else
Target = ""
'Worksheet_Change Target
End If
Application.EnableEvents = True
End If
If Not Intersect(Target, Range("I2:AL30000")) Is Nothing And Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
Select Case Target
Case "X"
Set MaDestination = Sheets("cotation").Range("A65536").End(xlUp).Offset(1, 0)
MaDestination.Value = Cells(1, Target.Column)
MaDestination.Offset(0, 1).Value = Cells(Target.Row, 2)
MaDestination.Offset(0, 2).Value = Cells(Target.Row, 4)
MaDestination.Offset(0, 3).Value = Cells(Target.Row, 8)
MaDestination.Offset(0, 4).Value = Cells(Target.Row, 5)
MaDestination.Offset(0, 6).Value = Cells(Target.Row, 6)
Case ""
For Each X In Sheets("cotation").Range("A2:" & Sheets("cotation").Range("A65536").End(xlUp).Address)
If X & X.Offset(0, 1) & X.Offset(0, 2) & X.Offset(0, 3) & X.Offset(0, 4) = Cells(1, Target.Column) &

Cells(Target.Row, 2) & Cells(Target.Row, 4) & Cells(Target.Row, 8) & Cells(Target.Row, 5) Then
X.EntireRow.Delete
Exit Sub
End If
Next
End Select
End If
End Sub
------------------------
 
Trier par date Trier par votes
Re : Macro

Bonjnour Ana, bonjour le forum,

Un fichier en pièce jointe aurait été le bienvenu... je te propose la macro suivante à adapter car tu ne précises pas où tu mets les X.

Code: 
Sub Macro1()
Dim cel As Range 'déclare la variable cel
Dim dest As Range 'déclare la variable dest
 
Application.EnableEvents = False
For Each cel In Range("I2:I3000") 'boucle sur toutes les cellules cel de la colonne I (de 2 à 3000)(à adapter)
    If cel.Value = "X" Then 'condition : si la valeur de la cellule est "X"
        Set dest = Sheets("récap").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
        Range(Cells(cel.Row, 10), Cells(cel.Row, 38)).Copy dest 'copie les colonnes J à AL de la ligne et les colle dans dest (à adapter)
    End If
Next cel 'prochaine cellule cel de la boucle
Application.EnableEvents = True
End Sub
 
Vote positif 0 Vote négatif
Re : Macro

Merci pour cette macro.
Je l'ai adapté et elle fonctionne très bien !

Est-il possible qu'en plus du recopiage de la ligne, ça me rajoute l'entête de la colonne où se trouve la croix ?

Exemple : Avec la Macro, la croix qui se trouve dans la cellule I5, recopie les 8 colonnes précédentes et dans une colonne supplémentaire, je voudrais qu'elle m'indique l'entête de la colonne I.

Est-ce possible ?



Sub Macro1()
Dim cel As Range 'déclare la variable cel
Dim dest As Range 'déclare la variable dest

Application.EnableEvents = False
For Each cel In Range("I2:AL3000") 'boucle sur toutes les cellules cel de la colonne I (de 2 à 3000)(à adapter)
If cel.Value = "X" Then 'condition : si la valeur de la cellule est "X"
Set dest = Sheets("récap").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest
Range(Cells(cel.Row, 1), Cells(cel.Row, 8)).Copy dest 'copie les colonnes A à H de la ligne et les colle dans dest (à adapter)
End If
Next cel 'prochaine cellule cel de la boucle
Application.EnableEvents = True
End Sub
 
Vote positif 0 Vote négatif
Re : Macro

Bonjour Ana, bonjor le forum,

la macro modifiée :

Code: 
Sub Macro1()
Dim cel As Range 'déclare la variable cel
Dim dest As Range 'déclare la variable dest
 
Application.EnableEvents = False
 
For Each cel In Range("I2:AL3000") 'boucle sur toutes les cellules cel de la colonne I (de 2 à 3000)(à adapter)
    If cel.Value = "X" Then 'condition : si la valeur de la cellule est "X"
        Set dest = Sheets("récap").Range("A65536").End(xlUp).Offset(1, 0)  'définit la variable dest
        Range(Cells(cel.Row, 1), Cells(cel.Row, 8)).Copy dest 'copie les colonnes A à H de la ligne et les colle dans dest (à adapter)
        [COLOR=red]dest.Offset(0, 9).Value = Cells(1, cel.Column) 'copie l'en-tête en colonne G[/COLOR]
    End If
Next cel 'prochaine cellule cel de la boucle
 
Application.EnableEvents = True
End Sub
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

U
  • Question Question
Autres [RÉSOLU] Compléter la macro mais comment et où?
Réponses
2
Affichages
758
un internaute
U
U
  • Question Question
Autres [RÉSOLU] Compléter macro pour Suppr cellules
Réponses
7
Affichages
458
un internaute
U
  • Résolu(e)
XL 2019 Modifier ce code pour de sorte à y rajouter un commentaire après clic droit en colonne I (9) à préremplir mais vierge ?
Réponses
8
Affichages
289
anthoYS
  • Résolu(e)
XL 2019 Comment modifier ces codes VB de sorte que le clic droit sur un commentaire présent, permette l'édition et non cette erreur (capture) ?
Réponses
6
Affichages
262
anthoYS
  • Résolu(e)
XL 2019 Adapter ce code, et améliorer le tableau avec graphique à l'année à y insérer ?
Réponses
4
Affichages
502
sylvanu
N
  • Question Question
Microsoft 365 gestion de kilometrage
Réponses
4
Affichages
495
nabilexcel2007
N
  • Question Question
Autres résultats differents entre formule et macro (excel 2007)
2
Réponses
18
Affichages
569
dysorthographie
U
  • Question Question
Autres [RÉSOLU] macro à modifier
Réponses
1
Affichages
621
un internaute
U
  • Question Question
XL 2016 intégrer une macro sur les nouvelles feuilles crées
Réponses
6
Affichages
262
pascal21
C
  • Résolu(e)
XL 2021 Mise en forme MsgBox
2 3
Réponses
43
Affichages
1 K
Constantin
C
F
  • Question Question
Microsoft 365 Problème mémoire insuffisante
Réponses
5
Affichages
926
TooFatBoy
  • Question Question
XL 2016 Renseigner une plage 2 a partir d'une plage 1 selon le mois.
Réponses
4
Affichages
277
KTM
P
  • Résolu(e)
Microsoft 365 VBA - Survol d'un Label déclenchement action
Réponses
8
Affichages
350
patricko-13
P
  • Question Question
XL 2016 annulation ou désactivation de macro
2
Réponses
27
Affichages
1 K
job75
A
  • Résolu(e)
XL 2019 Remplacer un mot et ajouter une couleur
Réponses
7
Affichages
613
Attila451
A
N
  • Question Question
XL 2013 Utilisé deux CommandButton_Click dans la même feuil
Réponses
4
Affichages
434
patricktoulon
X
  • Question Question
Microsoft 365 compte à rebours avec application.OnTime (Résolu)
Réponses
9
Affichages
365
xabino
X
C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
1 K
CortoXls
C
  • Résolu(e)
XL 2021 Problème réaffectation variable Objet
Réponses
2
Affichages
255
treza88
F
  • Question Question
XL 2021 probleme dans la macro
Réponses
4
Affichages
742
kiki29
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…