Recuperer nom onglet

Bonjour,

Je ne suis pas sûr que cela soit possible, mais est il possible après avoir fusionner plusieurs feuilles en une seule de récupérer en face de chaque ligne l'onglet à laquelle elle correspond.

Merci par avance

Bonjour,

dans votre code de recopie de ligne, il suffit d'ajouter à la bonne colonne le .Name de l'onglet en cours de "transfert"

Sheets("Feuil1").Name

@ bientôt

LouReeD

Bonjour antho19,

Je te retourne ton fichier modifié :

Ctrl c ➯ travail effectué

dhany

Merci beaucoup à vous,

Je n'arrive pas à le remettre en place dans mon code

Merci encore à vous de votre temps

[code][/Sub fusion()

Application.ScreenUpdating = False

For j = 1 To 14

Sheets(j).Select

Dl = Range("c" & Rows.Count).End(xlUp).Row

Range("b47:V" & Dl).Copy

Sheets("Synthèse").Activate

Lr = Range("D" & Rows.Count).End(xlUp).Row + 1

Cells(Lr, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

'Cells(Lr, 1).PasteSpecial xlPasteAll

Application.CutCopyMode = False

Next j

Range("b46").Select

Range("A:a, d:d, G:G, i:j, k:m, r:u").Delete

Range("C:C,G:G").Select

Selection.NumberFormat = "m/d/yyyy"

End Subcode]

Je te propose d'essayer ce code VBA :

Option Explicit

Sub fusion()
  Dim ws As Worksheet, Dl&, Lr&, j As Byte
  Set ws = ActiveWorkbook.Worksheets("Synthèse")
  Application.ScreenUpdating = False
  For j = 1 To 14
    With Worksheets(j)
      Dl = .Range("C" & Rows.Count).End(xlUp).Row
      .Range("B47:V" & Dl).Copy
      Lr = ws.Range("D" & Rows.Count).End(xlUp).Row + 1
      ws.Cells(Lr, 1).PasteSpecial Paste:=xlPasteValues
      'ws.Cells(Lr, 1).PasteSpecial xlPasteAll
      Application.CutCopyMode = False
      ws.Cells(Lr, 23).Resize(Dl - 46) = ActiveSheet.Name
    End With
  Next j
  Range("A:A, D:D, G:G, I:J, K:M, R:U").Delete
  Range("C:C,G:G").Select
  Selection.NumberFormat = "m/d/yyyy"
End Sub

dhany

Cela ne fonctionne pas, ca me reporte le nom de l'onglet synthèse et non celle de la feuille d'origine

dans ce cas, dans cette ligne :

ws.Cells(Lr, 23).Resize(Dl - 46) = ActiveSheet.Name

supprime ActiveSheet (en laissant le point) ➯ cette ligne devient :

ws.Cells(Lr, 23).Resize(Dl - 46) = .Name

note bien qu'à c'moment-là, .Name dépend de Worksheets(j)

(voir le With situé plus haut)

si ça marche : ok ; sinon, envoie ton fichier actuel.

dhany

Super merci ca fonctionne