Microsoft 365 VBA Copier / Coller Valeur sur une autre feuille, dernière ligne vide

S

Sylvain29

XLDnaute Nouveau
Bonjour,

Suite à de nombreuses recherches sur différents forums, je ne parviens pas à réaliser ma macro.
Je débute dans le codage VBA.
Je souhaite copier des données sur une feuille "Devis" non disposées sur une même ligne mais dans différentes cellules sur la feuille.
Puis coller leurs valeurs sur une autre feuille "suivi" sur une même ligne dans un tableau.
Je souhaite que ce collage se mette à la suite des lignes précédemment complété par cette procédure.
Je parviens à copier/coller ces valeurs sur la première ligne du tableau, mais mes différents essais pour compléter la dernière ligne disponible reste infructueux.

Voici ma macro :

Sub ajout_suivi_geste_co()

'Copie numéro de compte
Range("B13").Select
Selection.Copy
Sheets("Suivi Budget geste CO").Select
Range("C9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copie date mois
Sheets("Devis Clients").Select
Range("B14").Select
Selection.Copy
Sheets("Suivi Budget geste CO").Select
Range("B9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'copie nom client
Sheets("Devis Clients").Select
Range("C12").Select
Selection.Copy
Sheets("Suivi Budget geste CO").Select
Range("D9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'copie quanti et prix
Sheets("Devis Clients").Select
Range("G25:H25").Select
Selection.Copy
Sheets("Suivi Budget geste CO").Select
Range("F9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'copie référence
Sheets("Devis Clients").Select
Range("A25").Select
Selection.Copy
Sheets("Suivi Budget geste CO").Select
Range("E9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False



End Sub


Bien à vous.
Sylvain
 
Solution
job75
Bonjour Sylvain29, _Thierry,

Quand on ne copie que les valeurs le mieux est d'utiliser des tableaux VBA c'est bien plus rapide.

Voyez le fichier joint et cette macro :
VB: 
Sub ajout_suivi_geste_co()
Dim tablo, resu(), i&, n&
With Sheets("Devis Clients")
    tablo = .Range("A1", .UsedRange).Resize(, 8) 'matrice, plus rapide
End With
ReDim resu(1 To UBound(tablo), 1 To 6)
For i = 25 To UBound(tablo)
    If tablo(i, 1) <> "" Then
        n = n + 1
        resu(n, 2) = tablo(13, 2) 'numéro de compte
        resu(n, 1) = tablo(14, 2) 'date mois
        resu(n, 3) = tablo(12, 3) 'nom client
        resu(n, 5) = tablo(i, 7) 'Qté
        resu(n, 6) = tablo(i, 8) 'montant
        resu(n, 4) = tablo(i, 1) 'référence
    End If
Next
If n =...
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Bonjour Sylvain29, bienvenue sur XLD,

C'est votre 1ère visite alors retenez une seule chose : en VBA les Select sont à proscrire.

Votre macro peut se simplifier comme ceci :
VB: 
Sub ajout_suivi_geste_co()

'Copie numéro de compte
Sheets("Suivi Budget geste CO").Range("C9") = Sheets("Devis Clients").Range("B13")

'Copie date mois
Sheets("Suivi Budget geste CO").Range("B9") = Sheets("Devis Clients").Range("B14")

'copie nom client
Sheets("Suivi Budget geste CO").Range("D9") = Sheets("Devis Clients").Range("C12")

'copie quanti et prix
Sheets("Suivi Budget geste CO").Range("F9:G9") = Sheets("Devis Clients").Range("G25:H25").Value

'copie référence
Sheets("Suivi Budget geste CO").Range("E9") = Sheets("Devis Clients").Range("A25")

End Sub
Maintenant si vous voulez répéter l'opération sur plusieurs lignes il faut faire ce qu'en VBA on appelle une boucle en précisant bien les lignes sources et les lignes de destination.

A+
 
Vote positif 0 Vote négatif
_Thierry

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonjour @Sylvain29 , @job75, le Forum

En complément du Code de Base proposé par Job75, et toujours sans "Select" (oui c'est à eviter).

Et pour répondre à ceci,
Sylvain29 à dit:
Je souhaite que ce collage se mette à la suite des lignes précédemment complété par cette procédure
Cliquez pour agrandir...

Voici le code qui trouvera la Ligne où écrire à la suite :
VB: 
Option Explicit

Sub ajout_suivi_geste_co()
Dim WSSource As Worksheet, WSCible As Worksheet
Dim Ligne As Integer


Set WSSource = ThisWorkbook.Worksheets("Devis Clients")
Set WSCible = ThisWorkbook.Worksheets("Suivi Budget geste CO")

Ligne = WSCible.Range("B1000").End(xlUp).Row + 1
MsgBox Ligne

    With WSCible
        'Copie numéro de compte
        .Range("C" & Ligne) = WSSource.Range("B13")
        
        'Copie date mois
        .Range("B" & Ligne) = WSSource.Range("B14")
        
        'copie nom client
        .Range("D" & Ligne) = WSSource.Range("C12")
        
        'copie quanti et prix
        .Range("F" & Ligne & ":G" & Ligne) = WSSource.Range("G25:H25").Value
        
        'copie référence
        .Range("E" & Ligne) = WSSource.Range("A25")
    End With

End Sub

Bien à toi, à vous et welcome to XLD
@+Thierry
 
Vote positif 0 Vote négatif
S

Sylvain29

XLDnaute Nouveau
Merci beaucoup Job75 et _Thierry,

Je prends note de vos précieux conseils.
cela fonctionne, si je peux me permettre de vous demander encore un peu d'aide, les cellules copiées se collent parfaitement dans mon tableau de suivi. mais la première de ce tableau est automatiquement remplacée par la dernière.
Aussi j'aimerais copier et coller plusieurs lignes de mon devis en même temps.
référence A25:A60)
Quanti (G25:G60) ;
Prix (H25:H60),
et aussi que les cellules B14, C12 et B13 se répètent sur chaque lignes collées.

J'ai disposé ma macro comme ci-dessous :


Sub ajout_suivi_geste_co()

Dim WSSource As Worksheet, WSCible As Worksheet
Dim Ligne As Integer


Set WSSource = ThisWorkbook.Worksheets("Devis Clients")
Set WSCible = ThisWorkbook.Worksheets("Suivi Budget geste CO")

Ligne = WSCible.Range("B1000").End(xlUp).Row + 1
MsgBox Ligne

With WSCible
'Copie numéro de compte
.Range("C" & Ligne) = WSSource.Range("B13")

'Copie date mois
.Range("B" & Ligne) = WSSource.Range("B14")

'copie nom client
.Range("D" & Ligne) = WSSource.Range("C12")

'copie quanti et prix
.Range("F" & Ligne & ":G" & Ligne) = WSSource.Range("G25:H25").Value

'copie référence
.Range("E" & Ligne) = WSSource.Range("A25")
End With

'Copie numéro de compte
Sheets("Suivi Budget geste CO").Range("C9") = Sheets("Devis Clients").Range("B13")

'Copie date mois
Sheets("Suivi Budget geste CO").Range("B9") = Sheets("Devis Clients").Range("B14")

'copie nom client
Sheets("Suivi Budget geste CO").Range("D9") = Sheets("Devis Clients").Range("C12")

'copie quanti et prix
Sheets("Suivi Budget geste CO").Range("F9:G9") = Sheets("Devis Clients").Range("G25:H25").Value

'copie référence
Sheets("Suivi Budget geste CO").Range("E9") = Sheets("Devis Clients").Range("A25")

End Sub
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
D'après ce que je comprends vous voulez exécuter le code 36 fois (de A25 à A60).

Donc utilisez ce code :
VB: 
Sub ajout_suivi_geste_co()
Dim n As Byte
For n = 0 To 35
    Sheets("Suivi Budget geste CO").Range("C9").Offset(n) = Sheets("Devis Clients").Range("B13") 'numéro de compte
    Sheets("Suivi Budget geste CO").Range("B9").Offset(n) = Sheets("Devis Clients").Range("B14") 'date mois
    Sheets("Suivi Budget geste CO").Range("D9").Offset(n) = Sheets("Devis Clients").Range("C12") 'nom client
    Sheets("Suivi Budget geste CO").Range("F9:G9").Offset(n) = Sheets("Devis Clients").Range("G25:H25").Offset(n).Value 'quanti et prix
    Sheets("Suivi Budget geste CO").Range("E9").Offset(n) = Sheets("Devis Clients").Range("A25").Offset(n) 'référence
Next
End Sub
Edit : j'avais oublié que vous ne voulez pas décaler les cellules sources B13 B14 C12.

Si vous ne connaissez pas la fonction Offset faites une recherche sur le web.
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Si les lignes vides dans la feuille de destination ne vous gênent pas utilisez mon code post #5.

Sinon il est facile de supprimer ces lignes vides, utilisez une boucle inversée :
VB: 
Sub ajout_suivi_geste_co()
Dim w1 As Worksheet, w2 As Worksheet, n As Integer
Set w1 = Sheets("Devis Clients")
Set w2 = Sheets("Suivi Budget geste CO")
For n = 35 To 0 Step -1
    w2.Range("C9").Offset(n) = w1.Range("B13") 'numéro de compte
    w2.Range("B9").Offset(n) = w1.Range("B14") 'date mois
    w2.Range("D9").Offset(n) = w1.Range("C12") 'nom client
    w2.Range("F9:G9").Offset(n) = w1.Range("G25:H25").Offset(n).Value 'quanti et prix
    w2.Range("E9").Offset(n) = w1.Range("A25").Offset(n) 'référence
    If Application.CountA(w2.Range("B9:G9").Offset(n)) = 0 Then w2.Range("B9:G9").Offset(n).Delete xlUp 'supprime la ligne si elle est vide
Next
End Sub
 
Vote positif 0 Vote négatif
S

Sylvain29

XLDnaute Nouveau
_Thierry à dit:
Bonjour @Sylvain29 , @job75, le Forum

En complément du Code de Base proposé par Job75, et toujours sans "Select" (oui c'est à eviter).

Et pour répondre à ceci,


Voici le code qui trouvera la Ligne où écrire à la suite :
VB: 
Option Explicit

Sub ajout_suivi_geste_co()
Dim WSSource As Worksheet, WSCible As Worksheet
Dim Ligne As Integer


Set WSSource = ThisWorkbook.Worksheets("Devis Clients")
Set WSCible = ThisWorkbook.Worksheets("Suivi Budget geste CO")

Ligne = WSCible.Range("B1000").End(xlUp).Row + 1
MsgBox Ligne

    With WSCible
        'Copie numéro de compte
        .Range("C" & Ligne) = WSSource.Range("B13")
       
        'Copie date mois
        .Range("B" & Ligne) = WSSource.Range("B14")
       
        'copie nom client
        .Range("D" & Ligne) = WSSource.Range("C12")
       
        'copie quanti et prix
        .Range("F" & Ligne & ":G" & Ligne) = WSSource.Range("G25:H25").Value
       
        'copie référence
        .Range("E" & Ligne) = WSSource.Range("A25")
    End With

End Sub

Bien à toi, à vous et welcome to XLD
@+Thierry
Cliquez pour agrandir...


Merci pour vos réponses, j'ai testé l'ensemble de vos solutions proposées, cette proposition ci-dessus réalise exactement ce que je veux faire, mise à part quelle ne le fait que pour une ligne. Je ne parvient pas à faire une boucle pour répéter l’opération pour les lignes suivantes.
B13, B14 et C12 répétées sur chaque ligne de mon tableau de suivi (car ces données ne changent pas), et les cellules de G25 à G60 et de H25 à H60 (copier et coller leurs valeurs) lorsqu'elles ne sont pas vides.
En vous remerciant chaleureusement pour l'aide déjà apporté.
Bien à vous.
Sylvain29
 
Vote positif 0 Vote négatif
S

Sylvain29

XLDnaute Nouveau
Bonsoir,
ne voyez aucune malveillance de ma part,
Vos solutions copient bien plusieurs lignes, comme je le souhaite, mais écrasent les lignes précédemment coller par la macro dans le tableau de suivi. Notamment la première ligne de ce dernier. Votre dernière proposition répète plusieurs fois le copier collé, pour les cellules B14 B14 et C12.
Peut-être que j'exprime mal ma problématique.

Bien à vous
 
Vote positif 0 Vote négatif
_Thierry

_Thierry

XLDnaute Barbatruc
Repose en paix
Re Bonsoir

Est-ce que mon post #3 correspond à la demande pour :
Sylvain29 à dit:
Vos solutions copient bien plusieurs lignes, comme je le souhaite, mais écrasent les lignes précédemment coller par la macro dans le tableau de suivi.
Cliquez pour agrandir...

Car avec :
VB: 
Ligne = WSCible.Range("B1000").End(xlUp).Row + 1
MsgBox Ligne
La message box doit te dire sur quelle ligne il va écrire en trouvant toujours la dernière ligne vide de la colonne "B"... (En partant du bas à 1000 et en remontant)

Bonne soirée
@+Thierry
 
Vote positif 0 Vote négatif
S

Sylvain29

XLDnaute Nouveau
Bonjour _Thierry, bonjour job75,

Oui je pense qu'avec un fichier joint ce sera plus simple pour les explications. le fichier joint ne contient plus de données confidentielles (je l'ai allégée ;)). j'ai disposé plusieurs commentaires sur le document dans le but d'être le plus explicite possible.
Je vous souhaite un excellent après-midi.
Bien à vous.

Sylvain29
 

Pièces jointes

  • Classeur2.xlsm
    490 KB · Affichages: 25
Vote positif 0 Vote négatif
S

Sylvain29

XLDnaute Nouveau
Bonjour à tous,

j'ai trouvé la solution ci-dessous, c'est un peu répétitif mais ça fonctionne.
il ne me reste plus qu'a supprimer le message de confirmation qui se répète pour chaque ligne et se sera plus que parfait !

Sub ajout_suivi_geste_co()
Dim WSSource As Worksheet, WSCible As Worksheet
Dim Ligne As Integer


Set WSSource = ThisWorkbook.Worksheets("Devis Clients")
Set WSCible = ThisWorkbook.Worksheets("Suivi Budget geste CO")

Ligne = WSCible.Range("B1000").End(xlUp).Row + 1
MsgBox Ligne

With WSCible
'Copie numéro de compte
.Range("C" & Ligne) = WSSource.Range("B13")

'Copie date mois
.Range("B" & Ligne) = WSSource.Range("B14")

'copie nom client
.Range("D" & Ligne) = WSSource.Range("C12")

'copie quanti et prix
.Range("F" & Ligne & ":G" & Ligne) = WSSource.Range("G25:H25").Value

'copie référence
.Range("E" & Ligne) = WSSource.Range("A25")

Ligne = WSCible.Range("B1000").End(xlUp).Row + 1
MsgBox Ligne
'Copie numéro de compte
.Range("C" & Ligne) = WSSource.Range("B13")

'Copie date mois
.Range("B" & Ligne) = WSSource.Range("B14")

'copie nom client
.Range("D" & Ligne) = WSSource.Range("C12")

'copie quanti et prix
.Range("F" & Ligne & ":G" & Ligne) = WSSource.Range("G26:H26").Value

'copie référence
.Range("E" & Ligne) = WSSource.Range("A26")

Ligne = WSCible.Range("B1000").End(xlUp).Row + 1
MsgBox Ligne
'Copie numéro de compte
.Range("C" & Ligne) = WSSource.Range("B13")

'Copie date mois
.Range("B" & Ligne) = WSSource.Range("B14")

'copie nom client
.Range("D" & Ligne) = WSSource.Range("C12")

'copie quanti et prix
.Range("F" & Ligne & ":G" & Ligne) = WSSource.Range("G27:H27").Value

'copie référence
.Range("E" & Ligne) = WSSource.Range("A27")

End Sub
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Sylvain29, _Thierry,

Quand on ne copie que les valeurs le mieux est d'utiliser des tableaux VBA c'est bien plus rapide.

Voyez le fichier joint et cette macro :
VB: 
Sub ajout_suivi_geste_co()
Dim tablo, resu(), i&, n&
With Sheets("Devis Clients")
    tablo = .Range("A1", .UsedRange).Resize(, 8) 'matrice, plus rapide
End With
ReDim resu(1 To UBound(tablo), 1 To 6)
For i = 25 To UBound(tablo)
    If tablo(i, 1) <> "" Then
        n = n + 1
        resu(n, 2) = tablo(13, 2) 'numéro de compte
        resu(n, 1) = tablo(14, 2) 'date mois
        resu(n, 3) = tablo(12, 3) 'nom client
        resu(n, 5) = tablo(i, 7) 'Qté
        resu(n, 6) = tablo(i, 8) 'montant
        resu(n, 4) = tablo(i, 1) 'référence
    End If
Next
If n = 0 Then Exit Sub
'---restitution---
With Sheets("Suivi Budget geste CO")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Range("B" & Rows.Count).End(xlUp)(2) '1ère cellule vide en colonne B
        .Resize(n, 6) = resu
        .Resize(n, 6).Borders.Weight = xlThin 'bordures
        .Cells(1, 6).Font.Bold = False
        .Cells(n + 1, 6) = "=SUM(R8C:R[-1]C)"
        .Cells(n + 1, 6).Font.Bold = True
    End With
    .Activate 'facultatif
End With
End Sub
A+
 

Pièces jointes

  • Copier valeurs(1).xlsm
    380.8 KB · Affichages: 58
Dernière édition:
Vote positif 0 Vote négatif
Solution

Discussions similaires

R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
252
robpellan52
R
G
  • Résolu(e)
XL 2013 copier coller valeur d'une colonne dynamique
Réponses
13
Affichages
320
gwenn49
G
O
  • Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
431
olivier388
O
Usine à gaz
  • Résolu(e)
XL 2021 Coller "RdV Fait Facturé" de "J" ligne active jusqu'à "J" dernière ligne NON vide
2
Réponses
27
Affichages
587
TooFatBoy
TooFatBoy
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
Usine à gaz
  • Résolu(e)
XL 2021 Ecrire dans une une autre feuille
Réponses
3
Affichages
295
Usine à gaz
Usine à gaz
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
361
fanou06
F
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
516
mouchtre
mouchtre
X
  • Question
XL 2016 Copier à partir de la dernière ligne renseignée.
Réponses
8
Affichages
399
Xender
X
M
  • Question
Microsoft 365 Erreur de format
Réponses
5
Affichages
95
Marvin57
M

Membres actuellement en ligne

26 membres et 439 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 029
Messages
2 084 775
Membres
102 662
dernier inscrit
seb60240