macro avec fonction recherche et copie de données

  • Initiateur de la discussion Initiateur de la discussion lesuisse
  • 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 !

L

lesuisse

Guest
Bonjour à toutes et à tous,

J'ai une feuille avec des données dans plusieurs colonnes.
Dans les colonne A, j'ai plusieurs fois la meme variable qui sert de critère.
Je souhaite exploser cette liste de données sur la base du critère de la colonne A.
Donc en fait si EXCEL trouve dans la colonne A la valeur 8010000, qu'il me copie cette valeur dans une feuille appelée 801000. Et qu'il en fasse de meme pour toutes les cellules de la colonne A ou il trouvera ce critère.

Une explosion du fichier de base en feuille de détails.

Merci de votre aide.




Dim cell As Range

For Each cell In Range("A:A")
If cell = "8010000" Then
cell.EntireRow.Select
Selection.Copy
Sheets("8010000").Select
Range("A:A").Select
ActiveSheet.Paste
End If
Next cell
 

Pièces jointes

Bonjour Minick, le forum

Tout simplement sensationnel...
Cependant, est ce que tu pourrais s'il te plait, m'expliquer le contenu de la macro...
Le code me parait tellement compliqué...

Merci pour la macro et tes futures explications...

le petit suisse

Sub copie_Action()
Dim i As Integer
Dim NbrLigneSrc As Integer, NbrLigneDst As Integer
Dim FeuilDst As String, FeuilSrc As String

NbrLigneSrc = Range("A65536").End(xlUp).Row

On Error GoTo CreerFeuil
For i = 2 To NbrLigneSrc
FeuilDst = Range("a" & i)
Range("A" & i).EntireRow.Copy Sheets(FeuilDst) _
.Range("A" & Sheets(FeuilDst).Range("A65536").End(xlUp).Row + 1)
Next
On Error GoTo 0

Exit Sub

CreerFeuil:
FeuilSrc = ActiveSheet.Name
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = FeuilDst
Sheets(FeuilSrc).Range("A1").EntireRow.Copy Sheets(FeuilDst).Range("A1")
Sheets(FeuilSrc).Activate
Resume
End Sub
 
- 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

Retour