Copier coller certaines cellules sur autre feuille

[chandler282]

Bonjour,

Dans un fichier j'ai douze pages avec les mois de l'année avec environ 1000 entrées sur chaque page + 2 pages de reporting.

Mon souhait est de pouvoir envoyer par macro sur la page de reporting une partie seulement d'une ligne présente sur l'un des mois rien qu'en se positionnant sur une cellule de cette dite ligne et en cliquant sur le bouton Macro correspondant à la page reporting.

En gros, j'ai bien réussis à copier la ligne, à la coller sur la bonne feuille sur la 1ère ligne vide (a partir de la ligne 3) et, Oh miracle, à faire en sorte que cela colorie la ligne copiée (dans la feuille d'origine) dans la couleur souhaitée.

Cependant j'ai un soucis. En effet, je souhaiterai que cela ne me copie pas toute la ligne mais seulement les cases A, C, P, Q, T et U (Idéalement en fonction du titre de la colonne mais bon n'en demandons pas trop 😛)

Voici le code à aujourd'hui :

Sub CopierPromesses()
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Select
Selection.Copy Feuil2.Range("A65536").End(xlUp)(2)
L = ActiveCell.Row
Range(Cells(L, 1), Cells(L, 45)).Interior.ColorIndex = 22
ActiveCell.Offset(1, 0).Select
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String

' Promt
strPrompt = "La sélection a bien été copiée dans PROMESSES"

' Dialog's Title
strTitle = "Ok"

'Display MessageBox
iRet = MsgBox(strPrompt, vbQuestion, strTitle)
End Sub

Si quelqu'un peut faire quelque chose pour moi,
D'avance merci,
Bonne réception

 

[Modeste]

Re : Copier coller certaines cellules sur autre feuille

Bonjour chandler282,

Pour autant que j'aie bien compris, essaye en remplaçant

Rows(ActiveCell.Row & ":" & ActiveCell.Row).Select
Selection.Copy Feuil2.Range("A65536").End(xlUp)(2)

... Par

Union(Cells(L, 1), Cells(L, 3), Cells(L, 16), Cells(L, 17), Cells(L, 20), Cells(L, 21)).Copy _
    Feuil2.Range("A65536").End(xlUp)(2)

Pour ce qui est de "idéalement en fonction du titre de la colonne" ... sans avoir trouvé de titres aux colonnes en question, je sèche ...

 

[jp14]

Re : Copier coller certaines cellules sur autre feuille

Bonjour

Ci joint une solution avec les procédures modifiées.
Un seule macro à paramétrer pour les deux boutons, ce qui simplifie les modifications.
Les colonnes à copier sont dans les propriètès du classeur.

'Appel du programme avec passage des paramètres
'Feuille destination, nom de la feuille origine,Ligne active, couleur, adresse de la cellule active dans la feuille initiale
Sub CopierPromesses()
Call Copiedonnees("PROMESSES", ActiveSheet.Name, ActiveCell.Row, 22, ActiveCell.Address)
End Sub
Sub CopierRCI()
Call Copiedonnees("RCI", ActiveSheet.Name, ActiveCell.Row, 22, ActiveCell.Address)
End Sub


Private Sub Copiedonnees(Nomfeuille1 As String, Nomfeuille2 As String, L As Long, couleur As Byte, adresse As String)
Dim Prop1 As DocumentProperty
Dim lig2 As Long
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String

With Sheets(Nomfeuille1) 
lig2 = .Range("A" & .Rows.Count).End(xlUp).Row + 1 ' ligne pour mettre la copie
For Each Prop1 In ActiveWorkbook.CustomDocumentProperties ' pour chaque valeur ajouté dans les propriétés du classeur actif

    If InStr(1, UCase(Prop1.Name), "COLONNE") > 0 Then ' si dans le nom de la propriété on trouve le mot colonne alors 
        If Trim(Prop1.Value) <> "" Then ' si on a une valeur qui n'est pas un espace 
            .Range(Prop1.Value & lig2) = Sheets(Nomfeuille2).Range(Prop1.Value & L)' on recopie, la cellule qui a pour coordonnée la ligne active et pour colonne la valeur inscrite dans la propriété, dans la feuille spécifié.
' technique pour répondre à cette phrase ; "Idéalement en fonction du titre de la colonne"
' comme il n'y avait pas de nom, j'ai choisi une autre solution 

        End If
    End If
Next Prop1

Sheets(Nomfeuille2).Range(Cells(L, 1), Cells(L, 45)).Interior.ColorIndex = couleur

Sheets(Nomfeuille2).Range(adresse).Offset(1, 0).Select

 
    ' Promt
    strPrompt = "La sélection a bien été copiée dans " & Nomfeuille1
     ' Dialog's Title
    strTitle = "Ok"
 
    'Display MessageBox
    iRet = MsgBox(strPrompt, vbQuestion, strTitle)
End With
End Sub

A tester

JP

 

[chandler282]

Re : Copier coller certaines cellules sur autre feuille

Bonjour,

Merci pour le travail réalisé cependant lorsque j’essaie ta proposition Modeste cela m'affiche une erreur.

En revanche JP14 cela marche du tonnerre (d'ailleurs cela résout un autre de mes problèmes à savoir la mise en forme du texte. Je ne souhaitai pas conserver la mise en forme de la page de départ mais adapter le texte coller en fonction de la page d'arrivée.)
Sincèrement je ne sais pas comment ton code fonctionne (je sais juste que cela marche). J'avais un peu peur de devoir adapter ton code en fonction des noms de feuilles et de ne pas m'y retrouver. J'ai tenté de modifier les "nomfeuille1" et "nomfeuille2" par le nom réel des dites feuilles et ça ne change rien (ça fonctionne toujours). J'ai donc vérifié que cela fonctionne sur toutes les pages (JANVIER, FEVRIER, MARS, Etc. ...) et ça semble être le cas. Le seul truc qui fonctionne moyen c'est la Messagebox qui n'affiche plus le nom de la page et se contente d'afficher "La sélection a bien été copiée dans "

Pourrais-tu m'en dire un peu plus sur ton code afin que je puisse éventuellement l'adapter au besoin.

D'avance merci,
A bientôt

 

[Modeste]

Re : Copier coller certaines cellules sur autre feuille

Bonsoir,

Si tu préfères le code de jp14, ce n'est pas moi qui en ferai une maladie 😉 (ça m'a permis de voir comment récupérer des propriétés du fichier!).

Donc, juste pour ne pas laisser de questions en suspens, j'aurais dû préciser que l'instruction "L = ActiveCell.Row" devait se trouver au-dessus des lignes de mon exemple.

Chez moi, ça fonctionne ...

 

[jp14]

Re : Copier coller certaines cellules sur autre feuille

Bonsoir
Salut Modeste.

Une première réponse concernant le message
Le nom de la feuille de destination étant dans la variable Nomfeuille1 le code suivant permettait l'affichage du nom.
strPrompt = "La sélection a bien été copiée dans " & Nomfeuille1

JP

 

[chandler282]

Re : Copier coller certaines cellules sur autre feuille

Bonsoir Modeste et désolé si j'ai semblé ne pas prêter plus attention que cela au travail fourni 🙄

En effet je l'avais mal positionné et depuis le code fonctionne très bien, en ayant de plus l'avantage d'être simple (et donc peut-être modifiable et plus facilement adaptable pour un néophyte comme moi 😉)

Par contre avec ce code je retombe dans mon 2ème souci, à savoir la mise en forme du texte. En effet, j'aurai souhaité ne pas conserver la mise en forme de la page de départ mais adapter le texte collé en fonction de la page d'arrivée. (En gros, si sur la page d'arrivée le texte est en gras souligné, je souhaiterai qu'il en soit de même pour le texte qui y arrivera ...). Je dois avouer que ceci est secondaire et peut d'ailleurs peut-être faire l'objet d'une 2ème macro indépendante ...

Encore merci pour ton aide,
Bonne soirée

 

[chandler282]

Re : Copier coller certaines cellules sur autre feuille

Bonsoir jp14,

Je viens de faire les modifs (remis tout d'origine) et ça refonctionne bien (ce qui confirme que je n'ai rien compris à ton code ...😛). Petite question : Y aurait-il moyen d'avoir deux couleurs distincts en fonction des deux macros ?

D'avance merci,
Bonne soirée

 

[jp14]

Re : Copier coller certaines cellules sur autre feuille

Bonjour

Il faut modifier la valeur 22 dans la ligne

Call Copiedonnees("RCI", ActiveSheet.Name, ActiveCell.Row, 22, ActiveCell.Address)
Les valeurs correspondent aux variables suivantes

Copiedonnees(Nomfeuille1 As String, Nomfeuille2 As String, L As Long, couleur As Byte, adresse As String)
Adresse sert à se positionner dans la feuille de départ, cf code.
Sheets(Nomfeuille2).Range(adresse).Offset(1, 0).Select.


Si on utilise des couleurs comme "#FF0000" il faut changer le type de variable mettre "String" à la place de "Byte" et écrire "22"

PS : j'ai rajouté des commentaires dans la procédure.


JP