Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

S

spier

XLDnaute Nouveau
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?
 
Solution
S
bonjour,

j'ai trouvé une solution qui ne fait pas de copies parasites.
voici le code:
VB: 
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...
Trier par date Trier par votes

Wayki

XLDnaute Impliqué
Bonjour,
On sait que la feuille d'origine s'appelle "APPEL MEDICAL" du coup :
Après sans fichier compliqué d'apporter une solution concrète.
A +
 
Vote positif 0 Vote négatif
S

spier

XLDnaute Nouveau
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.
 

Pièces jointes

  • essais.xlsm
    127.9 KB · Affichages: 3
Vote positif 0 Vote négatif
S

spier

XLDnaute Nouveau
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.
 
Vote positif 0 Vote négatif

Wayki

XLDnaute Impliqué
spier à dit:
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.
Cliquez pour agrandir...
Et en rajoutant :
VB: 
For i = LBound(tbl) to UBound(tbl)
.Cells(i,15) = "APPEL MEDICAL"
Next i
Avant le end with
A +
 
Dernière édition:
Vote positif 0 Vote négatif
S

spier

XLDnaute Nouveau
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.

VB: 
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ÛT0,00026,7805,3632,14IDE2400BLOC OPERATOIREServicesHAppel Medical20228
CATH
11-août​
11-août​
AOÛT0,00026,7805,3632,14IDE2400BLOC OPERATOIREServicesH
CATH
11-août​
11-août​
AOÛT0,00026,7805,3632,14IDE2400BLOC OPERATOIREServicesH
CATH
11-août​
11-août​
AOÛT0,00026,7805,3632,14IDE2400BLOC OPERATOIREServicesH
CATH
11-août​
11-août​
AOÛT0,00026,7805,3632,14IDE2400BLOC OPERATOIREServicesHAppel Medical20228
CATH
11-août​
11-août​
AOÛT0,00026,7805,3632,14IDE2400BLOC OPERATOIREServicesH
CATH
11-août​
11-août​
AOÛT0,00026,7805,3632,14IDE2400BLOC OPERATOIREServicesHAppel Medical20228
CATH
11-août​
11-août​
AOÛT0,00026,7805,3632,14IDE2400BLOC OPERATOIREServicesHAppel Medical20228

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+
 
Vote positif 0 Vote négatif
S

spier

XLDnaute Nouveau
bonjour,

j'ai trouvé une solution qui ne fait pas de copies parasites.
voici le code:
VB: 
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.
 
Vote positif 0 Vote négatif
Solution

Wayki

XLDnaute Impliqué
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 :
VB: 
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 +
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

N
  • Résolu(e)
Microsoft 365 Supprimer de la liste d'une Combo les données déjà présentes dans une colonne d'un TS
2
Réponses
18
Affichages
546
NONO14
N
N
  • Question
Microsoft 365 Alimenter une Combo Active X inséré dans une feuille de calcul
Réponses
3
Affichages
173
NONO14
N
N
  • Résolu(e)
Microsoft 365 Remplir une ComboBox à 3 colonnes avec les données d'un TS
4 5 6
Réponses
78
Affichages
1 K
Dudu2
N
  • Résolu(e)
Microsoft 365 Mettre la 4ème colonne d'une ListBox au format [h]:mm
3 4 5
Réponses
68
Affichages
1 K
NONO14
N
E
  • Résolu(e)
XL 2019 transfer listbox vers une colonne à partir de la 4 ligne
Réponses
2
Affichages
143
escudo
E
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
361
marie3107
M
N
  • Résolu(e)
Microsoft 365 Transfère de données d'un Userform vers un tableau structuré d'une feuille de calcul
Réponses
4
Affichages
241
NONO14
N
  • Question
Power Query Data Model - renvoyer le résultat d'une requête PQ sans passer par une feuille
Réponses
11
Affichages
429
Staple1600
F
  • Résolu(e)
Microsoft 365 Donner a une cellule le nom de la feuille
Réponses
5
Affichages
437
Faroyo
F
E
  • Résolu(e)
Microsoft 365 Ajout et Suppression Date automatique
Réponses
9
Affichages
435
eric72
E
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…