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

Macro copie - débutant

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion tofty
  • 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 !

S'inscrire
T

tofty

Guest
Bonjour à tous,

Je me présente Christophe 24ans, je débute dans le VBA et j'aurais une question concernant ma 1ère macro.

Je m'excuse d'avance si la solution a déjà été donnée mais je préfère poser ma question avant de parcourir le forum et les tutoriels complémentaires 🙂

Mon but est de copier une centaine de lignes d'une colonne d'une feuille vers une autre feuille du même fichier par transpose, avec ajout de la date du jour dans la 1ère colonne et ensuite effacer ces cellules pour pouvoir entrer à nouveau des paramètres. Pour cela pas de problème 🙂

Là où ca se complique, c'est lorsque je souhaite pouvoir copier à nouveau cette colonne dans la seconde feuille sans écraser les données déjà présentes, tout en ajoutant la date du jour dans la 1ère colonne.

Si quelqu'un pouvait m'éclairer sur le sujet 🙂


Voici le code actuel :

Code: 
Sub test1()

    ' Copier le contenu des cellules D2->D192 de "Input" dans "Data" par transpose à partir de B4
    Sheets("Input").Select
    Range("D2:D192").Select
    Selection.Copy
    Sheets("Data").Select
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
 
    ' Ajouter la date du jour dans la cellule A4 dand "Data"
    Sheets("Data").Select
    Range("A4").Select
    ActiveCell.FormulaR1C1 = Date
    
    ' Effacer le contenu des cellules B3->B16 dans "R-shunt"
    Sheets("R-shunt").Select
    Range("B3:B16").Select
    Selection.ClearContents
    
    ' Effacer le contenu des cellules B3->B31 dans "Knee curve"
    Sheets("Knee curve").Select
    Range("B3:B31").Select
    Selection.ClearContents
    
    ' Effacer le contenu des cellules B3->B43 dans "Radial track"
    Sheets("Radial track").Select
    Range("B3:B43").Select
    Selection.ClearContents
    
    ' Effacer le contenu des cellules D2 et D87->D192 dans "Input"
    Sheets("Input").Select
    Application.CutCopyMode = False
    Range("D2").Select
    Selection.ClearContents
    Range("D87:D192").Select
    Selection.ClearContents
    
End Sub

Merci d'avance
 
Trier par date Trier par votes
Re : Macro copie - débutant

Bonjour tofty, et bienvenue,

Tous mes encouragements pour tes débuts dans VBA.

Voici ton code corrigé :

Code: 
Sub test1()

    ' Copier le contenu des cellules D2->D192 de "Input" dans "Data" par transpose à partir de B4
    Sheets("Input").Range("D2:D192").Copy
    Sheets("Data").Select
    ' Définir la 1ère ligne vide dans la colonne A:A
    Lg = Range("A65536").End(xlUp).Row + 1
    Range("B" & Lg).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
 
    ' Ajouter la date du jour dans la cellule A4 dand "Data"
    Range("A" & Lg).FormulaR1C1 = Date
   
    ' Effacer le contenu des cellules B3->B16 dans "R-shunt"
    Sheets("R-shunt").Range("B3:B16").ClearContents
   
    ' Effacer le contenu des cellules B3->B31 dans "Knee curve"
    Sheets("Knee curve").Range("B3:B31").ClearContents
   
    ' Effacer le contenu des cellules B3->B43 dans "Radial track"
    Sheets("Radial track").Range("B3:B43").ClearContents
   
    ' Effacer le contenu des cellules D2 et D87->D192 dans "Input"
    Sheets("Input").Select
    Application.CutCopyMode = False
    Range("D2, D87:D192").ClearContents
   
End Sub

Tu remarqueras que j'ai grandement simplifié ton code : il n'est nul besoin, en effet, de sélectionner des feuilles ou des cellules pour leur appliquer une action : il suffit de faire précéder les instructions par leur référence. L'avantage, outre un code plus concis, est également un déroulement plus rapide de la macro.

Espérant avoir répondu.

Cordialement.
 
Vote positif 0 Vote négatif
Re : Macro copie - débutant

Bonjour tofty, papou 🙂

Une autre solution :

Code: 
Sub test1()

    ' Déclaration de la variable ligne
    Dim ligne As Long
    
    ' Détermination de la ligne à remplir
    ligne = Sheets("Data").Range("A65536").End(xlUp).Row + 1
    If ligne < 4 Then ligne = 4
    
    ' Copier le contenu des cellules D2->D192 de "Input" dans "Data" par transpose à partir de Bx
    Sheets("Data").Cells(ligne, "B").Resize(, 191) = Application.Transpose(Sheets("Input").Range("D2:D192").Value)
    
    ' Ajouter la date du jour dans la cellule Ax dand "Data"
    Sheets("Data").Cells(ligne, "A") = Date
    
    ' Effacer le contenu des cellules B3->B16 dans "R-shunt"
    Sheets("R-shunt").Range("B3:B16").ClearContents
    
    ' Effacer le contenu des cellules B3->B31 dans "Knee curve"
    Sheets("Knee curve").Range("B3:B31").ClearContents
    
    ' Effacer le contenu des cellules B3->B43 dans "Radial track"
    Sheets("Radial track").Range("B3:B43").ClearContents
    
    ' Effacer le contenu des cellules D2 et D87->D192 dans "Input"
    Sheets("Input").Range("D2,D87:D192").ClearContents
    
End Sub

En VBA il est presque toujours inutile d'utiliser les Select ou autres Selection.

A+
 
Vote positif 0 Vote négatif
Re : Macro copie - débutant

Bonjour tofty, Papou-net 🙂, job75 🙂,
Très a la bourre mais comme j'ai fait quelque chose.....
VB: 
Sub test1()
    ' Copier le contenu des cellules D2->D192 de "Input" dans "Data" par transpose à partir de B4
    With Sheets("Data")
        lig = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Range("B" & lig & ":GJ" & lig) = Application.Transpose(Sheets("Input").Range("D2:D192").Value)
        ' Ajouter la date du jour dans la cellule A4 dand "Data"
        .Range("A" & lig) = Date
    End With
    ' Effacer le contenu des cellules D2 et D87->D192
    Range("D2").Range("D87:D192").ClearContents
    ' Effacer le contenu des cellules B3->B16 dans "R-shunt"
    Sheets("R-shunt").Range("B3:B16").ClearContents
    ' Effacer le contenu des cellules B3->B31 dans "Knee curve"
    Sheets("Knee curve").Range("B3:B31").ClearContents
    ' Effacer le contenu des cellules B3->B43 dans "Radial track"
    Sheets("Radial track").Range("B3:B43").ClearContents
    'Affichier feuille Input
    Sheets("Input").Activate
End Sub
Cordialement
 
Vote positif 0 Vote négatif
Re : Macro copie - débutant

Bonjour Papou-net, merci 🙂

Ton code est simple,efficace et surtout, il fonctionne à la perfection 🙂

Merci pour les explications, je vais de se pas me plancher sur le sujet afin de comprendre tout ça 🙂
 
Vote positif 0 Vote négatif
Re : Macro copie - débutant


Bonjour job75, Efgé,

Merci à toi, job75, d'avoir complété ma proposition : j'avais effectivement oublié de supprimer le dernier Select.

Cordialement.
 
Vote positif 0 Vote négatif
Re : Macro copie - débutant

Bonjour job75 et Efgé, merci pour vos solutions 🙂

Je vais pouvoir apprendre pas mal de chose grâce à vos 3 codes.

J'ai rarement vu un forum actif avec des personnes aussi efficaces 🙂
 
Vote positif 0 Vote négatif
Re : Macro copie - débutant

Re
Il y a une "carabistouille" dans ma première proposition, je la corige:

VB: 
Sub test1()
    ' Copier le contenu des cellules D2->D192 de "Input" dans "Data" par transpose à partir de B4
    With Sheets("Data")
        lig = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Range("B" & lig & ":GJ" & lig) = Application.Transpose(Sheets("Input").Range("D2:D192").Value)
        ' Ajouter la date du jour dans la cellule A4 dand "Data"
        .Range("A" & lig) = Date
    End With
    ' Effacer le contenu des cellules D2 et D87->D192
    Sheets("Input").Range("D2, D87:D192").ClearContents
    ' Effacer le contenu des cellules B3->B16 dans "R-shunt"
    Sheets("R-shunt").Range("B3:B16").ClearContents
    ' Effacer le contenu des cellules B3->B31 dans "Knee curve"
    Sheets("Knee curve").Range("B3:B31").ClearContents
    ' Effacer le contenu des cellules B3->B43 dans "Radial track"
    Sheets("Radial track").Range("B3:B43").ClearContents
    'Affichier feuille Input
    Sheets("Input").Activate
End Sub
Cordialement
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Macro copie - débutant

Voici donc le code de Papou-net 'corrigé' :

Code: 
Sub test1()

    ' Copier le contenu des cellules D2->D192 de "Input" & sélectionner "Data"
    Sheets("Input").Range("D2:D192").Copy
    Sheets("Data").Select
    
    ' Définir la 1ère ligne vide dans la colonne A:A de "Data" & coller les valeurs copiées
    Lg = Range("A65536").End(xlUp).Row + 1
    Range("B" & Lg).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
 
    ' Ajouter la date du jour dans la 1ère colonne vide de "Data"
    Range("A" & Lg).FormulaR1C1 = Date
   
    ' Effacer le contenu des cellules B3->B16 dans "R-shunt"
    Sheets("R-shunt").Range("B3:B16").ClearContents
   
    ' Effacer le contenu des cellules B3->B31 dans "Knee curve"
    Sheets("Knee curve").Range("B3:B31").ClearContents
   
    ' Effacer le contenu des cellules B3->B43 dans "Radial track"
    Sheets("Radial track").Range("B3:B43").ClearContents
   
    ' Effacer le contenu des cellules D2 et D87->D192 dans "Input"
    Sheets("Input").Range("D2, D87:D192").ClearContents
   
End Sub

Encore merci 🙂
 
Vote positif 0 Vote négatif
Re : Macro copie - débutant

Re,

tofty vous allez découvrir une variable Objet (un peu spéciale).

C'est pour le fun car je reconnais que ça devient un peu "trapu" 🙂

Code: 
Sub test1()

    ' Déclaration des variables F et ligne
    Dim F As Object, ligne As Long
    
    ' Feuilles à traiter
    Set F = Sheets(Array("Data", "Input", "R-shunt", "Knee curve", "Radial track"))
    
    ' Détermination de la ligne à remplir
    ligne = F(1).Range("A65536").End(xlUp).Row + 1
    If ligne < 4 Then ligne = 4
    
    ' Copier le contenu des cellules D2->D192 de "Input" dans "Data" par transpose à partir de Bx
    F(1).Cells(ligne, "B").Resize(, 191) = Application.Transpose(F(2).Range("D2:D192").Value)
    
    ' Ajouter la date du jour dans la cellule Ax dans "Data"
    F(1).Cells(ligne, "A") = Date
    
    ' Effacer le contenu des cellules B3->B16 dans "R-shunt"
    F(3).Range("B3:B16").ClearContents
    
    ' Effacer le contenu des cellules B3->B31 dans "Knee curve"
    F(4).Range("B3:B31").ClearContents
    
    ' Effacer le contenu des cellules B3->B43 dans "Radial track"
    F(5).Range("B3:B43").ClearContents
    
    ' Effacer le contenu des cellules D2 et D87->D192 dans "Input"
    F(2).Range("D2,D87:D192").ClearContents
    
End Sub
 
Vote positif 0 Vote négatif
Re : Macro copie - débutant


Y-a pas à dire, ça fait plus "pro".

Cordialement.
 
Vote positif 0 Vote négatif
Re : Macro copie - débutant

Re à tous,
Si "on va par là"... et sur le dernier code de Job,
VB: 
Sub test2()
Dim F As Object, R(), ligne As Long
Set F = Sheets(Array("Data", "Input", "R-shunt", "Knee curve", "Radial track"))
R = Array("", "D2,D87:D192", "B3:B16", "B3:B31", "B3:B43")
With F(1)
    ligne = .Range("A65536").End(xlUp).Row + 1
    If ligne < 4 Then ligne = 4
    .Cells(ligne, "B").Resize(, 191) = Application.Transpose(F(2).Range("D2:D192").Value)
    .Cells(ligne, "A") = Date
End With
For i = 2 To F.Count
    F(i).Range(R(i - 1)).ClearContents
Next i
End Sub
Cordialement
 
Vote positif 0 Vote négatif
Re : Macro copie - débutant

Salut Efgé,

Je ne t'avais pas salué, pardonne-moi 🙂

Efgé à dit:
Si "on va par là"...
Cliquez pour agrandir...

On y va, on y va 😎

Code: 
Sub test2()
Dim F As Object, R, ligne As Long, i As Byte
Set F = Sheets(Array("Data", "Input", "R-shunt", "Knee curve", "Radial track"))
R = Array("D2,D87:D192", "B3:B16", "B3:B31", "B3:B43")
'--------
For i = 2 To F.Count
    F(i).Range(R(i - 2)).ClearContents
Next i
End Sub
A+
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Macro copie - débutant

Re
Je ne t'avais pas salué, pardonne-moi
Cliquez pour agrandir...
Pas de problème Job 🙂,
VB: 
R = Array("D2,D87:D192", "B3:B16", "B3:B31", "B3:B43")
'--------
For i = 2 To F.Count
         F(i).Range(R(i - 2)).ClearContents
Next i
Merci de la correction du code, j'ai vraiment du mal avec ces P_ _ _ _ n(s) de listes qui commencent à 1 et ces non-moins P_ _ _ _ n(s) de tableaux qui commencent à 0 😉

A te recroiser, avec plaisir.
Cordialement

EDIT: Pour notre ami tofty ait un code "complet":
VB: 
Sub test3()
Dim F As Object, R, ligne As Long, i As Byte
Set F = Sheets(Array("Data", "Input", "R-shunt", "Knee curve", "Radial track"))
R = Array("D2,D87:D192", "B3:B16", "B3:B31", "B3:B43")
With F(1)
    ligne = .Range("A65536").End(xlUp).Row + 1
    If ligne < 4 Then ligne = 4
    .Cells(ligne, "B").Resize(, 191) = Application.Transpose(F(2).Range("D2:D192").Value)
    .Cells(ligne, "A") = Date
End With
For i = 2 To F.Count
    F(i).Range(R(i - 2)).ClearContents
Next i
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Macro copie - débutant

Bonjour à tous, au fil
Toujours "en allant par là"... ...mais plus loin 😉. Promis, après j'arrête 😉.
VB: 
Sub test4()
Dim T(), ligne As Long, i As Byte
T = Array(Array("Input", "D2,D87:D192", "D2:D192"), _
          Array("R-shunt", "B3:B16"), Array("Knee curve", "B3:B31"), _
          Array("Radial track", "B3:B43"), "Data")
With Sheets(T(UBound(T)))
    ligne = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    If ligne < 4 Then ligne = 4
    .Cells(ligne, "A") = Date
    .Cells(ligne, "B").Resize(, 191) = _
    Application.Transpose(Sheets(T(0)(0)).Range(T(0)(2)).Value)
End With
For i = LBound(T) To UBound(T) - 1
   Sheets(T(i)(0)).Range(T(i)(1)).ClearContents
Next i
End Sub
Cordialement
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

A
  • Question Question
XL pour MAC Problème avec une macro dupliquant une feuille contenant une macro
Réponses
8
Affichages
389
AlineJ
A
D
  • Question Question
Microsoft 365 VBA copier cellule, conserver la copie tout en effaçant contenu
2 3
Réponses
33
Affichages
2 K
fanch55
  • Résolu(e)
XL 2019 macro conditon
2
Réponses
25
Affichages
2 K
job75
M
  • Question Question
XL 2013 Envoyer un mail automatique avec le contenu de la bonne ligne
Réponses
2
Affichages
1 K
Oneida
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
3 K
AtTheOne
P
  • Résolu(e)
Autres Macro trop longue
Réponses
6
Affichages
684
TooFatBoy
R
  • Question Question
Microsoft 365 Ecraser onglet par copier coller [RESOLU]
Réponses
4
Affichages
647
romubzh35
R
  • Question Question
XL 2016 Aide pour userform (sujet clos)
Réponses
8
Affichages
733
tactic6
C
  • Résolu(e)
XL 2016 Remplir automatiquement un tableau d'après des conditions et des valeurs
Réponses
11
Affichages
2 K
ERIC S
J
  • Question Question
Copie valeurs
Réponses
4
Affichages
1 K
JLR67
J
E
  • Question Question
Microsoft 365 associer la valeur d'une cellule à ma macro en sélectionnant la bonne extension année
Réponses
5
Affichages
855
Hasco
C
  • Question Question
Microsoft 365 Bug au démarrage de ma macro
Réponses
3
Affichages
708
ChTi160
M
  • Question Question
XL 2016 Problème Macro
2
Réponses
17
Affichages
2 K
patricktoulon
P
  • Question Question
XL 2016 Macro, Copier coller des cellules fusionnées en fonction d'un texte
Réponses
1
Affichages
925
Deadpool_CC
M
  • Question Question
Microsoft 365 Evolution macro - VBA - Copier/coller en fonction d'une ligne
Réponses
6
Affichages
2 K
melinavy
M
N
  • Résolu(e)
XL 2010 intégrer une liste de donnée à la suite (1ère case vide)
Réponses
14
Affichages
1 K
sousou
R
  • Question Question
XL 2019 Macro VBA autofill à partir de la première cellule vide du tableauRépondre
Réponses
2
Affichages
1 K
Hasco
A
  • Question Question
Microsoft 365 boucle macro pour importer des données
2
Réponses
16
Affichages
2 K
Arnaud Legay
A
M
  • Question Question
XL 2019 Macro copier /coller une ligne dans un tableau (du menu insertion/tableau)
Réponses
9
Affichages
2 K
micsel
M
E
  • Résolu(e)
Microsoft 365 Créer une macro qui va dans un dossier récupérer un fichier
5 6 7
Réponses
92
Affichages
11 K
Etoto
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…