Chercher une cellule et copier les valeurs de sa colonne

Le 13/08/2016 à 20:26

Bonjour à tous.

Je souhaiterais ajouter quelques actions à un module existant (Creer_un_devis_PDF).

Lorsque j'enregistre le devis en PDF (en utilisant le module existant Creer_un_devis_PDF) , il faudrait que - pour le devis précisé* - le prix du matériel soit fixé (plutôt que de conserver des formules). Pour cela, il faut donc :

1) que je me rende dans la feuille "Achats",

2) que je recherche la colonne propre au devis (dans le fichier joint ci-dessous, je recherche donc la colonne commençant par D-595)

3) que je copie cette colonne, et que j'y colle uniquement les valeurs qui s'y trouvent.

J'ai fait l'enregistrement de cette nouvelle macro que vous trouverez ci-dessous, mais il y a encore quelques petites améliorations à apporter. Il faudrait :

1) que la macro cherche ce qui est contenu dans la cellule F1 de la feuille « matériel » plutôt que la valeur D-1192,

2) qu'il sélectionne la colonne propre au devis précisé* (dans le fichier ci-joint, il s'agit donc de sélectionner la colonne J:J plutôt que FH:FH).

* le devis précisé dans la cellule F1 de la feuille "Matériel"

    Sheets("Matériel").Select
    Range("F1").Select
    Selection.Copy
    Sheets("Achats").Select
    Cells.Find(What:="D-1192", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Range("FH:FH").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End Sub

Dans un premier temps, il faudrait bien mettre au point la macro ci-dessus, mais ensuite il faudrait l'incorporer dans la macro existante (ci-dessous). J'ai indiqué l'endroit supposé de l'incorporation par des ========

Sub Creer_un_devis_PDF()

    Dim sRep As String
    Dim sFilename As String
    Dim FichierExistant As Boolean
    'On déclare les variables utilisées.

    Sheets(Array("Devis", "Matériel", "Mensualités")).Select
    'On sélectionne les feuilles voulues.

    sRep = "\\PC-BLEU\Google Drive\Hors cours\Devis - Clients\"
    'Mettre le nom de l'emplacement souhaité.

    sFilename = ThisWorkbook.Worksheets("Devis").Range("J1").Value
    'Mettre le nom de la cellule voulu pour le nom du fichier.

    'sFilename = InputBox("Veuillez renseigner un nom de fichier :", "Nom de fichier", ThisWorkbook.Worksheets("Devis").Range("J1").Value)
    'Cette ligne permet de saisir un autre nom de fichier, sinon c'est le texte de la cellule J1 qui est pris.

    'If sFilename = "" Then Exit Sub
    'Sort de la macro si aucun nom n'a été donné ou que Annuler a été choisit précédemment

    FichierExistant = (Dir(sRep & sFilename & ".pdf") <> "")
    'La variable devient Vrai si le fichier existe.

    If FichierExistant = True Then
        If MsgBox("Le fichier existe déjà. Voulez-vous le remplacer ?", vbYesNo, "Demande de confirmation") = vbNo Then
            ThisWorkbook.Worksheets("Devis").Select
            Exit Sub
        End If
    End If
    'Vérifie et demande une confirmation si il y a déjà un fichier du même nom.

    ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sRep & sFilename, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False

    '======== Je pense qu'il faut incorporer le nouveau code ici =================  

    Sheets(Array("Devis")).Select

    ActiveSheet.Range("D14").Copy

    Range("G1").Select

End Sub

19devis-pour-forum.xlsm (73.27 Ko)

Le 18/08/2016 à 05:37

Pas de réponse

Le 18/08/2016 à 07:36

Bonjour