[excel]transfert de donnée de multiples onglets

Signaler
Messages postés
1
Date d'inscription
mardi 31 janvier 2017
Statut
Membre
Dernière intervention
31 janvier 2017
-
Messages postés
8354
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
22 janvier 2021
-
Bonjour,
je n'ai pas l'habitude de demander de l'aide mais la je ne sais pas par où attaquer mon problème.
J'ai un fichier excel avec de nombreux onglets numérotés feuil1, feuil2..... (parfois des chiffres manque surement de onglets supprimés)
je dois sur un fichier reporter les données de ces onglets sur une seul feuille avec une ligne par onglet.
vu la quantité de données et d'onglet j'ai peur à l'erreur de saisie j'aurais voulu faire une macro mais Là je suis perdu.
si quelqu'un pouvait m'aider ce serait vraiment sympathique merci

1 réponse

Messages postés
8354
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
22 janvier 2021
21
Bonjour,

« je dois sur un fichier [...] une ligne par onglet »
Ce code copie une ligne de chaque onglet dans un nouveau classeur :
Option Explicit
Sub test()
Const n°L As Long = 1             'Ligne à copier
Dim wbk As Workbook               'Nouveau fichier
Dim wsh As Worksheet              'Feuille
Dim rng As Range                  'Plage à copier
Dim cel As Range                  'Cellule de destination
  'Créer un nouveau classeur
  Set wbk = Application.Workbooks.Add(xlWBATWorksheet)
  'Définir la première cellule de destination des résultats
  Set cel = wbk.Worksheets(1).Range("A1")
  'Mettre en place les titres de colonne
  cel.Value = "Onglet"
  cel.Offset(0, 1).Value = "Lignes n° " & n°L
  cel.Resize(1, 2).Font.Bold = True
  'définir la prochaine cellule de destination (cellule en dessous)
  Set cel = cel.Offset(1)
  'Analyser chaque onglet du classeur
  For Each wsh In ThisWorkbook.Worksheets
    'Écrire le nom de l'onglet dans la cellule de destination
    cel.Value = wsh.Name
    With wsh
      'Définir la plage utilisées de la ligne à copier
      Set rng = .Range(.Cells(n°L, 1), .Cells(n°L, .Columns.Count).End(xlToLeft))
      'Copier cette plage vers la cellule à coté de la cellule de destination
      rng.Copy Destination:=cel.Offset(0, 1)
    End With
    'définir la prochaine cellule de destination (cellule en dessous)
    Set cel = cel.Offset(1)
  Next wsh
End Sub