Petit souci de macro - Découpage tableau en plusieurs onglets

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

emiliepo

XLDnaute Nouveau
Bonjour,

J'ai un petit souci avec ma macro et je ne parviens pas à trouver d'où vient le problème.

Mon fichier Excel se compose d'un tableau regroupant un ensemble de postes informatiques:

Sans titre.jpg

Je souhaite découper ce tableau en plusieurs onglets triés sur la colonne B Site.

Bien sur je souhaite conserver l'entête du tableau. La macro que j'ai réalisé fonctionne à moitié car elle ne me copie que la première ligne de chaque site. Pourriez vous m'aider à trouver l'erreur?

Merci d'avance pour votre aide.

Voici la macro:

Sub Decoupsites()
Dim Ws As Worksheet
Dim trouve As Boolean
Dim contenu As String
Dim lig, derlig As Integer
With Sheets("ARTGO Systemes")
derlig = .Range("B65536").End(xlUp).Row
For lig = 6 To derlig
contenu = .Cells(lig, 2).Value
For Each Ws In ThisWorkbook.Worksheets
trouve = False
If StrComp(Ws.Name, contenu, vbTextCompare) = 0 Then
trouve = True
Exit For
End If
Next Ws
If trouve = True Then
.Rows(lig).Copy Sheets(contenu).Range("A65536").End(xlUp).Offset(1, 0)
Else
Sheets.Add
ActiveSheet.Name = contenu
.Rows(1).Copy Sheets(contenu).Range("A1")
.Rows(2).Copy Sheets(contenu).Range("A2")
.Rows(3).Copy Sheets(contenu).Range("A3")
.Rows(4).Copy Sheets(contenu).Range("A4")
.Rows(5).Copy Sheets(contenu).Range("A5")
End If
Next lig
End With
End Sub
 

Pièces jointes

  • Sans titre.jpg
    Sans titre.jpg
    53.8 KB · Affichages: 34
  • Sans titre.jpg
    Sans titre.jpg
    53.8 KB · Affichages: 38
Re : Petit souci de macro - Découpage tableau en plusieurs onglets

bonjour Emiliepo le forum
oui c'est normal avec ta macro, là pas le temps mais met ton fichier en pièce jointe et je te ferai cela ce soir
a+
Papou🙂
 
- 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

Réponses
4
Affichages
461
Réponses
4
Affichages
177
Retour