Macro copie de cellules

Version imprimable

22/02/2021, 09h09
Freedavys18

Macro copie de cellules

Bonjour à tous,

J'ai peu d'expérience en macro, c'est pour cela que je sollicite votre aide. J'ai un fichier où j'ai deux feuilles. Ma première feuille contient des cellules un peu dispersées . Dans ma deuxième feuille, j'ai un tableau où je veux positionner des infos des cellules de la feuille 1. Avec un bouton sur la feuille 1 , je veux transferer les infos des cellules choisis et les mettre dans la feuille 2 dans des cellules prédifinies. Je veux également contrôler que la ligne de la feuille 2 soit vide pour autoriser le collage .
Exemple: Feuille 1, je copie les cellules K12, A2, M3 dans la feuille 2 en ligne 1 vers les cellules A2,B2,C2.
J'espère avoir été clair,

Merci de votre retour,

Cordialement

bonjour
si tu cherches à envoyer les données dans la première ligne non vide tester :

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub test()
Dim f1 As Worksheet
Dim f2 As Worksheet
Dim derlig As Long
Set f1 = Sheets("Feuil1")
Set f2 = Sheets("Feuil2")
derlig = f2.Range("A" & Rows.Count).End(xlUp).Row + 1
f1.Range("k12").Copy f2.Range("A" & derlig)
f1.Range("A2").Copy f2.Range("B" & derlig)
f1.Range("M3").Copy f2.Range("C" & derlig)
End Sub

Faut-il respecter l'ordre K12-A2-M3, ou bien peut-on copier la 1ère cellule de la feuille1 vers la feuille2, puis la 2ème ... etc. ?
S'il n'y a pas d'ordre spécifique, alors enregistrer votre fichier sous format "Xlsm" et copier ce code dans un module, que vous pouvez lancer avec la touche F5:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Option Explicit
 
Sub CopierCellules()
'Remplacez "Sheet1" et "Sheet2" par les noms de vos 2 feuilles.
    Dim adr As String
    Dim myRow As Long
    Dim j As Long: j = 1
 
    adr = Sheets("Sheet1").Range("A1").SpecialCells(xlLastCell).Address
    adr = "$A$1:" & adr
    myRow = 1+Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
 
    For Each c In Sheets("Sheet1").Range(adr)
        If c <> "" Then
            c.Copy Sheets("Sheet2").Cells(myRow, j)
            j = j + 1
        End If
    Next c
    MsgBox "Terminé !"
 
End Sub

22/02/2021, 10h08
Freedavys18

Merci de votre retour,

en fait ma feuille est un formulaire à remplir et ma feuille 2 synthètise les données renseignées sous forme d'un tableau me permettant de filtrer sur des colonnes pour rechercher par exemple un nom, etc..;
Par exemple, que ma cellule K12 de ma feuille 1 correspond à ma première cellule de ma colonne A ( par exemple Nom du client), ma cellule M13 de ma feuille 1 correspond à ma première cellule de colonne B (adresse du client)...
Une fois la feuille 1 rempli, l'appui sur le bouton renseigne les colonnes de mon tableau en feuille 2.

Merci à vous
22/02/2021, 10h14
BENNASR

as tu testé les deux propositions ?

Oui, j'ai essayé ci-dessous et cela fonctionne :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Private Sub CommandValider_Click() Dim f1 As Worksheet Dim f2 As Worksheet Dim derlig As Long Set f1 = Sheets("Client") Set f2 = Sheets("Suivi") If MsgBox("Etes-vous certain de vouloir enregistrer le contenu ?", vbYesNo, "Demande de confirmation") = vbYes Then derlig = f2.Range("A" & Rows.Count).End(xlUp).Row + 1 f2.Range("A" & derlig) = f1.Range("K11").Value f2.Range("B" & derlig) = f1.Range("K13").Value f2.Range("C" & derlig) = f1.Range("K15").Value f2.Range("D" & derlig) = f1.Range("J8:L8").Value f2.Range("E" & derlig) = f1.Range("K5").Value f2.Range("F" & derlig) = f1.Range("E10:E11").Value f2.Range("G" & derlig) = f1.Range("F10:F11").Value f2.Range("H" & derlig) = f1.Range("G10:G11").Value f2.Range("J" & derlig) = f1.Range("K19").Value f2.Range("K" & derlig) = f1.Range("K22").Value f2.Range("L" & derlig) = f1.Range("H35").Value MsgBox "Les informations ont été transférées dans la feuille suivi" End If End Sub
Cependant je suis confronté à un autre problème , dans ma feuille client, j'ai ma colonne E qui peut contenir 5 lignes de références pour un même client.il faudrait que je puisse tester la colonne E et transférer sur la feuille 2 les références sur plusieurs lignes puisque j'ai une seul colonne nommé référence.
J'espère être clair encore merci pour votre aide

22/02/2021, 18h39
BENNASR

Bonsoir
Pour ne pas tourner en vide et aller directement au but peux tu envoyer un fichier test sans données confidentielles
Avec un exemple précis

Bonjour,

j'ai encore besoin de votre aide. J'ai une feuille type formulaire vierge et je souhaite avec un bouton créer une copie de la feuille et la renommer avec la valeur d'une cellule (nom du client). Une fois l'opération effectuée, je souhaite rendre vierge à nouveau mon formulaire.
j'ai testé ce code qui fonctionne mais je n'arrive pas à mettre la feuille copiée en dernier.
Code:

1 2 3 4 5 6 7 8 9 10 11 Private Sub Creerficheclient_Click() Dim Sh As Worksheet If MsgBox("Etes-vous certain de vouloir créer la fiche client ?", vbYesNo, "Demande de confirmation") = vbYes Then Set Sh = ThisWorkbook.Worksheets.Add Sh.Name = Range("K11") ThisWorkbook.Worksheets("Client").UsedRange.Copy Sh.Range("A1") End If End Sub
Merci de votre aide

22/02/2021, 19h13
BENNASR

Je pense qu'au lieu d'ajouter une feuille a chaque nouvelle facture je pense a créer un dossier de sauvegarde sous format PDF ... Que pensez vous
Si c'est ce que tu cherches demain je développerais un bout de code
Pour ce je renouvelle ma demande d'un petit fichier sans données confidentielles
22/02/2021, 19h25
Freedavys18

Oui parfait en PDF.
J'envoi le fichier
22/02/2021, 20h30
Freedavys18

1 pièce(s) jointe(s)

Ci-joint le fichier :Pièce jointe 591682

bonjour
tester ça :
1 - à relier avec votre bouton de commande
2 - le PDF s'enregistre sous le meme dossier que le fichier Excel : je crois que ouvrir un nouveau dossier réservé à ton petite application et les formulaires y relatifs s'enregistre avec
Code:

1 2 3 4 5 6 7 8 9 Sub enregistPDF() Dim Ar(0) As String Ar(0) = Feuil1.Name Sheets(Ar).Select ' ActiveSheet.Range("A1:L37").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & "Mesure pour le client " & Range("K13") _ , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=False End Sub

23/02/2021, 10h32
Freedavys18

Bonjour ,

Merci , c'est super !! Fonctionnement Ok. J'ai tenté de le faire, le Pdf, et j'étais confronté à l'erreur 1004. Je vois qu'il faut ajouter Thisworkbook ;-)
Concernant mon autre demande, dans l'onglet Client, je peux avoir plusieurs références. Comment je peux les envoyer dans l'onglet suivi ? car cela marche quand j'ai une réf mais si j'en ai plusieurs , il faudrait que j'insere plusieurs ligne avec le meme client ?

Merci de votre aide,

Cordialement.

bonjour
1 - éviter la fusion des cellules
2 - chercher le nombre des lignes non vide dans la zonne E10:E19 avec

Code:

nbrelig = f1.Range("E10:E19").Find("*", , , , xlByColumns, xlPrevious).Row - 9

et répéter les données communes pour chaque ligne selon la valeur trouver
ce qui donne :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Private Sub CommandValider_Click()
Dim f1 As Worksheet
Dim f2 As Worksheet
Dim derlig As Long
Set f1 = Sheets("Client")
Set f2 = Sheets("Suivi")
nbrelig = f1.Range("E10:E19").Find("*", , , , xlByColumns, xlPrevious).Row - 9
If MsgBox("Etes-vous certain de vouloir enregistrer le contenu  ?", _
                        vbYesNo, "Demande de confirmation") = vbYes Then
For Z = 1 To nbrelig
derlig = f2.Range("A" & Rows.Count).End(xlUp).Row + 1
f2.Range("A" & derlig) = f1.Range("K11").Value
f2.Range("B" & derlig) = f1.Range("K13").Value
f2.Range("C" & derlig) = f1.Range("K15").Value
f2.Range("D" & derlig) = f1.Range("J8:L8").Value
f2.Range("E" & derlig) = f1.Range("K5").Value
f2.Range("F" & derlig) = f1.Range("E" & Z + 9).Value
f2.Range("G" & derlig) = f1.Range("F" & Z + 9).Value
f2.Range("H" & derlig) = f1.Range("G" & Z + 9).Value
f2.Range("J" & derlig) = f1.Range("K19").Value
f2.Range("K" & derlig) = f1.Range("K22").Value
f2.Range("L" & derlig) = f1.Range("H35").Value
Next Z
MsgBox "Les informations ont été transférées dans la feuille suivi"
End If
End Sub

à tester avec prudence sur une copie de ton ficheir

Merci pour ce retour.
J'ai apporté une modification car si dans le tableau des références j'ai la personne qui saisie une ligne sur 2, je me retrouve dans suivi avec des lignes inutiles. De même je voudrais que le bouton pour transférer dans l'onglet suivi control que mon tableau de réf et quantité ne soit pas vide. J'ai tenté de le faire mais j'ai une erreur :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Private Sub CommandSave_Click()
Dim f1 As Worksheet
Dim f2 As Worksheet
Dim derlig As Long
Set f1 = Sheets("Client")
Set f2 = Sheets("Suivi")

If f1.Range("E10:H19") = "" Then
MsgBox "Vous devez renseigner les références rideaux" + Chr(10) + " avant de transférer vers le suivi !!!"
Exit Sub
End If

nbrelig = f1.Range("E10:E19").Find("*", , , , xlByColumns, xlPrevious).Row - 9
If MsgBox("Etes-vous certain de vouloir enregistrer le contenu  ?", _
                        vbYesNo, "Demande de confirmation") = vbYes Then
For Z = 1 To nbrelig
derlig = f2.Range("A" & Rows.Count).End(xlUp).Row + 1
If f1.Range("E" & Z + 9) <> "" Then
f2.Range("A" & derlig) = f1.Range("K11").Value
f2.Range("B" & derlig) = f1.Range("K13").Value
f2.Range("C" & derlig) = f1.Range("K15").Value
f2.Range("D" & derlig) = f1.Range("J8:L8").Value
f2.Range("E" & derlig) = f1.Range("K5").Value

f2.Range("F" & derlig) = f1.Range("E" & Z + 9).Value
f2.Range("G" & derlig) = f1.Range("F" & Z + 9).Value
f2.Range("H" & derlig) = f1.Range("G" & Z + 9).Value
End If
f2.Range("J" & derlig) = f1.Range("K19").Value
f2.Range("K" & derlig) = f1.Range("K22").Value
f2.Range("L" & derlig) = f1.Range("H35").Value
Next Z
MsgBox "Les informations ont été transférées dans la feuille suivi"
End If
End Sub