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

MACRO - Insertion/Couper /RECOPIE selon conditions

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion Marjo2
  • 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

Marjo2

XLDnaute Occasionnel
Bonjour forum,

Je suis dans l'urgence et vient demander votre aide.
Un code VBA est nécessaire car la masse d'information a traité est importante.

L'onglet EXPORT correspond au résultat brut que l'on me donne.
Pour arriver à l'onglet RESULTAT A OBTENIR, j'ai fait :
- insertion d'une colonne entre B et C
- Couper de la colonne B, les cellules qui sont en majuscule (ou texte) et coller dans cette colonne nouvellement créer
- Recopie de haut en bas jusqu'à la prochaine cellule non vide

- insertion d'une colonne entre A et B
- Couper de la colonne A, les cellules de moins de 4 caractères pour les coller dans cette colonne nouvellement créer
- Recopie de haut en bas jusqu'à la prochaine cellule non vide

- Supprimer les lignes dont les cellules E sont vides.

Quelqu'un pour m'aider ?
 

Pièces jointes

Trier par date Trier par votes
VB: 
Sub Marjo()
    Columns(2).Insert Shift:=xlToRight
    Columns(4).Insert Shift:=xlToRight
For lig = 1 To [A65000].End(3).Row
If Cells(lig, 5) = "" Then num = Cells(lig, 1): bbb = Cells(lig, 3): lig = lig + 1
If IsNumeric(Cells(lig, 3)) Then Cells(lig, 2) = Cells(lig, 1): Cells(lig, 1) = num: Cells(lig, 4) = bbb
If Not IsNumeric(Cells(lig, 3)) Then Cells(lig, 4) = Cells(lig, 3): Cells(lig, 3) = ""
Next
For lig = [A65000].End(3).Row To 1 Step -1
If Cells(lig, 5) = "" Then Rows(lig).Delete
Next
End Sub
Bonjour Marjo,
Voici le fichier avec la macro
Bruno
 

Pièces jointes

Vote positif 0 Vote négatif
Remplacer la macro par celle-ci
difficile pour moi de faire mieux.
Dans tous les cas il faut supprimer et déplacer des données.
PS je fais pour 65000 lignes, si plus faut le signaler….
Bruno
VB: 
Sub Marjo()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    Columns(2).Insert Shift:=xlToRight
    Columns(4).Insert Shift:=xlToRight
bas = [A65000].End(3).Row
[D1:D65000].Value = [C1:C65000].Value
For lig = 1 To bas
If Cells(lig, 5) = "" Then num = Cells(lig, 1): bbb = Cells(lig, 3): lig = lig + 1
If IsNumeric(Cells(lig, 3)) Then Cells(lig, 2) = Cells(lig, 1): Cells(lig, 1) = num: Cells(lig, 4) = bbb
If Not IsNumeric(Cells(lig, 3)) Then Cells(lig, 3) = ""
Next
For lig = bas To 1 Step -1
If Cells(lig, 5) = "" Then Rows(lig).Delete
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
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

Discussions similaires

J
  • Résolu(e)
Microsoft 365 [RESOLU] VBA boucle, insertion plusieurs lignes, exécution formules, suppression sur si
Réponses
5
Affichages
789
Phil69970
R
  • Question Question
Microsoft 365 problème incompatibilité de type 13 sur macro "couper - coller"
Réponses
6
Affichages
524
rh.finances
R
O
  • Question Question
Autres recopie de cellules selon la date
Réponses
3
Affichages
324
olivier Clech
O
O
  • Question Question
XL 2019 erreur de valeur sur formule
2
Réponses
18
Affichages
1 K
olivier1984
O
S
  • Question Question
Microsoft 365 Référer à la première cellule non vide en haut
Réponses
3
Affichages
579
ShrekL
S
K
  • Résolu(e)
XL 2019 Aide pour macro vba
2
Réponses
20
Affichages
1 K
Kev1407
K
H
  • Résolu(e)
Microsoft 365 Archivage automatique sous condition (Macro)
Réponses
2
Affichages
661
HugoLaChips
H
B
  • Question Question
Microsoft 365 Créer une boucle sur une plage de cellule, couper coller et envoyer par mail
Réponses
1
Affichages
618
Hasco
S
  • Résolu(e)
XL 2019 Macro couper lignes selon conditions
Réponses
5
Affichages
746
soan
S
M
  • Résolu(e)
Microsoft 365 Compil de tableaux vers la droite
Réponses
7
Affichages
790
momo
M
  • Résolu(e)
Microsoft 365 Masquer des colonnes aux cellules avec valeurs données selon sélection d'une liste déroulante
Réponses
5
Affichages
1 K
PatFr38
M
  • Question Question
XL 2016 Résumé une colonne dans une autre
Réponses
1
Affichages
346
vgendron
B
  • Question Question
XL 2016 Macro BVA pour créer une synthèse à partir de plusieurs onglets Excel
Réponses
6
Affichages
1 K
bnolwalid
B
A
  • Question Question
Microsoft 365 RECOPIE VALEURS SELON CONDITIONS
Réponses
6
Affichages
876
Abdoul aziz
A
Z
  • Question Question
XL 2016 Macro couper coller vers onglet suivant
Réponses
3
Affichages
1 K
Zykmu
Z
A
  • Question Question
Microsoft 365 Recopie de valeurs selon conditions
Réponses
6
Affichages
722
sousou
EXCEL :: Les Tableaux Structurés :: Une classe VBA - V1.05 - Evolutions majeures exports CSV, XML, XML UTF-8, JSON, HTML, PDF, JPG, JPEG, BMP, EXCEL
Réponses
10
Affichages
1 K
oguruma
S
  • Question Question
Microsoft 365 Macro pour couper coller une ligne vers une autre feuille Excel
Réponses
1
Affichages
1 K
sylvanu
R
  • Résolu(e)
XL 2016 Copie Coller par Macro d'une feuille à une autre et coller à partir d'une cellule vide
Réponses
3
Affichages
984
shinozak
A
  • Question Question
Microsoft 365 Remplir colonne selon conditions
Réponses
2
Affichages
1 K
Abdoul aziz
A
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…