XL 2013 ajouter une colonne avec le nom de la feuille d'origine

[spier]

Bonjour,

j'ai un code de copie qui fonctionne très bien, mais je voudrais ajouter le nom de la feuille d'origine dans la colonne o sur ma feuille "copie".

Sub COPIE_LES_LIGNES()
With Sheets("APPEL MEDICAL")
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _
tbl.Columns.Count).Copy
End With
With Sheets("COPIE")
.[B1].CurrentRegion.Insert Shift:=xlDown
Application.CutCopyMode = False
End With
End Sub

Auriez-vous une idée de code que je puisse insérer?

 

[Wayki]

Bonjour,
On sait que la feuille d'origine s'appelle "APPEL MEDICAL" du coup :

Sub COPIE_LES_LIGNES()
With Sheets("APPEL MEDICAL")
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _
tbl.Columns.Count).Copy
End With
With Sheets("COPIE")
.[B1].CurrentRegion.Insert Shift:=xlDown
Application.CutCopyMode = False
.Range("O1") = "APPEL MEDICAL"
End With
End Sub

Après sans fichier compliqué d'apporter une solution concrète.
A +

 

[spier]

voici mon fichier.
j'appelle ma copie par le bouton "copier"(qui sera par la suite sur chacun des onglets), les lignes copiées incrémentent la feuille "copie".
je te remercie.

 

[spier]

Bonsoir,

j'ai effectivement déjà essayé d'ajouter
.Range("O1") = "APPEL MEDICAL"
mais ça me copie que sur la première ligne et pas sur toutes les lignes copiées.
En tout cas merci pour l'essai.

 

[Wayki]

Bonsoir,

j'ai effectivement déjà essayé d'ajouter
.Range("O1") = "APPEL MEDICAL"
mais ça me copie que sur la première ligne et pas sur toutes les lignes copiées.
En tout cas merci pour l'essai.

Et en rajoutant :

For i = LBound(tbl) to UBound(tbl)
.Cells(i,15) = "APPEL MEDICAL"
Next i

Avant le end with
A +

 

[spier]

Bonjour,
Je te remercie pour ton aide mais je n'ai pas trouvé de solution avec Ubound.
J'ai finalement opté pour me contenter d'avoir les infos sur la première ligne et utilisé entirerow pour me sortir du décalage.
Mais je rencontre un autre problème.

With Sheets("APPEL MEDICAL")
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _
 tbl.Columns.Count).EntireRow.Select
 Selection.Copy
   End With
With Sheets("Feuil1")
    Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
.range("o1") = "Appel Medical"
 End With
 With Sheets("Feuil1").range("o1")
        .Font.Color = -65536
        .Font.Bold = False
        .Font.Size = 8
        .Font.Name = "Comic Sans MS"
        Application.CutCopyMode = False
    'Fin de l'instruction avec : End With
    End With
     With Sheets("Feuil1").range("q1")
        .Formula = "= month(D1)"
        .Font.Color = -16777216
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
        .Font.Size = 8
        .Font.Name = "Comic Sans MS"
        Application.CutCopyMode = False
        End With
         With Sheets("Feuil1").range("p1")
        .Formula = "= year(D1)"
        .Font.Color = -16777216
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
        .Font.Size = 8
        .Font.Name = "Comic Sans MS"
        .NumberFormat = "General"
        Application.CutCopyMode = False
    End With
 End Sub

Au bout de trois clics sur mon bouton ça rajoute des lignes à ma copie.
Pour tester, mon tableau n'a qu'une seule ligne.

CATH	11-août​	11-août​	AOÛT	0,000	26,780	5,36	32,14	IDE	2400	BLOC OPERATOIRE	Services	H	Appel Medical	2022	8
CATH	11-août​	11-août​	AOÛT	0,000	26,780	5,36	32,14	IDE	2400	BLOC OPERATOIRE	Services	H
CATH	11-août​	11-août​	AOÛT	0,000	26,780	5,36	32,14	IDE	2400	BLOC OPERATOIRE	Services	H
CATH	11-août​	11-août​	AOÛT	0,000	26,780	5,36	32,14	IDE	2400	BLOC OPERATOIRE	Services	H
CATH	11-août​	11-août​	AOÛT	0,000	26,780	5,36	32,14	IDE	2400	BLOC OPERATOIRE	Services	H	Appel Medical	2022	8
CATH	11-août​	11-août​	AOÛT	0,000	26,780	5,36	32,14	IDE	2400	BLOC OPERATOIRE	Services	H
CATH	11-août​	11-août​	AOÛT	0,000	26,780	5,36	32,14	IDE	2400	BLOC OPERATOIRE	Services	H	Appel Medical	2022	8
CATH	11-août​	11-août​	AOÛT	0,000	26,780	5,36	32,14	IDE	2400	BLOC OPERATOIRE	Services	H	Appel Medical	2022	8

Je ne trouve pas de solution, j'ai cherché par rapport au presse papier, mais pas de changement.

Si quelqu'un à une idée, je suis preneuse.
A+

 

[spier]

bonjour,

j'ai trouvé une solution qui ne fait pas de copies parasites.
voici le code:

Sub COPIE_AM()

 Sheets("APPEL MEDICAL").Select
    Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _
tbl.Columns.Count).EntireRow.Select
    Selection.Copy
    Sheets("COPIE").Select
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
   
    Application.CutCopyMode = False
   
  With Sheets("COPIE").range("o1")
        .Value = "appel Médical"
        .Font.Color = -65536
        .Font.Bold = False
        .Font.Size = 8
        .Font.Name = "Comic Sans MS"
        .HorizontalAlignment = xlCenter
 
     With Sheets("COPIE").range("q1")
        .Formula = "= month(D1)"
        .Font.Color = -16777216
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
        .Font.Size = 8
        .Font.Name = "Comic Sans MS"
       
       
         With Sheets("COPIE").range("p1")
        .Formula = "= year(D1)"
        .Font.Color = -16777216
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
        .Font.Size = 8
        .Font.Name = "Comic Sans MS"
        .NumberFormat = "General"
       
    End With
    End With
     End With
      Sheets("APPEL MEDICAL").Select
    range("C11").Select
   
End Sub

merci
bonne soirée.

 

[Wayki]

Bonsoir,
Je répond tard mais je n'avais pas le temps de me pencher sur votre problème.
J'ai une solution mais qui ne traite pas la mise en forme, seulement les données.
La voici :

Option Base 1
Sub COPIE_LES_LIGNES()
Dim a()
a = ActiveCell.CurrentRegion
ReDim Preserve a(ActiveCell.CurrentRegion.Rows.Count, ActiveCell.CurrentRegion.Columns.Count + 1)
For i = 2 To UBound(a, 1)
    a(i, UBound(a, 2)) = "APPEL MEDICAL"
Next i
Sheets("copie").range("B1").Resize(UBound(a, 1), UBound(a, 2)) = a
End Sub

A +