Recopier des données d'une feuille dans une autre

Bonjour à tous,

Je souhaite récupérer des données d'une feuille qui se trouve dans un fichier sur mon ordi pour copier ces données dans une autre feuilles. Pour cela, je veux créer une boite de dialogue qui me demande d'aller ouvrir le fichier dans mon ordi et ensuite copier et coller des valeurs spécifiques.

Pour être plus précis je développe un outil pour avoir les données énergie d'un site. Donc les données que je souhaite récupérer sont les données d'électricité, de gaz, de fioul, réseau chaud et réseau froid, eau. Il y aura donc un fichier pour chaque énergie. Donc l'idée, c'est de créer une boite de dialogue qui demande dans un premier temps si on souhaite importer des donnés, si la réponse est oui, il demande si on si on souhaite imposer des données électriques, si la réponse est oui, il demande d'aller chercher le fichier dans l'ordinateur. Si la réponse est non, il passe à l'énergie suivante et répète l'exercice pour toutes les énergies.

Vous pouvez m'aider à écrire pour la première énergie et moi je répèterais l'exercice sur les autres énergies en changeant là où je dois aller chercher les informations.

J'utilise un mac donc je ne peux donc pas utiliser des fonctions qui sont Windows only comme active X, etc. On peut écrire le programme et j'attribuerais un le programme créé à un bouton créer.

Je vous joins le fichier "outils" et le fichier "données du pdl" il s'agit ici des données d'électricité. Mais j'aurais un fichier de la même forme pour le gaz aussi. Je vais donc chercher les infos dans donnée du PDL pour le mettre dans outils.

J'avais un code que j'avais utilisé pour un usage similaire, mais pour un autre outils et il avait été développé avec des fonctions Windows only , donc ne marche pas sur mac.

Je peux vous envoyer le fichier outils en mail, car volumineux pour le glisser ici. Ou alors vous partager le lien drive :(.

Sub traitement_relamping()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim chemin As String
    Dim dossier As String
    Dim monFichier As String
    Dim wbk_source As Workbook
    Dim twb As Workbook
    Dim ws_hypo As Worksheet
    Dim ws_fr As Worksheet
    Dim ws_led_global As Worksheet
    Dim lastligne_led_global As Integer
    Dim i As Integer
    Dim nom_fichier_fr As String
    Dim nom_fichier_led As String

    Set twb = ThisWorkbook
    Set ws_hypo = ThisWorkbook.Sheets("Hypothese de calculs")
    Set ws_led_global = ThisWorkbook.Sheets("Analyse ouvet client (8h-19h)")

    dossier = ws_hypo.Range("dossier_input").Value
    chemin = ThisWorkbook.Path & "\" & dossier & "\"

    'la fonction Dir(chemin, mode) permet de parcourir un dossier
    'ici je rajoute à mon chemin "*.xlsx" pour ne retrouver que mes fichiers Excel (si CSV, mettre CSV)
    'vbNormal permet de ne récupérer que des fichiers,
    'vbDirectory récupère tout (dossiers et fichiers)
    monFichier = Dir(chemin & "*.xlsx", vbNormal)

    'monFichier n'a récupéré que le premier élément trouvé
    'j'ai donc besoin d'un boucle pour les retrouver un à un
    Do While monFichier <> ""
        'on va utiliser ce nom pour ouvrir le classeur et y faire des modifications
        Application.ScreenUpdating = False

        Workbooks.Open chemin & "\" & monFichier

        Set wbk_source = ActiveWorkbook
        Set ws_fr = wbk_source.Sheets(1)

        '**************************************************************************************************************************
        '**************************************************************************************************************************
        '**************************************************************************************************************************

        'copie du tableau
        ws_fr.Activate
        ws_fr.Select
        ws_fr.Range("F2").Select

        Application.ScreenUpdating = False
        twb.Activate
        ws_hypo.Activate
        ws_hypo.Select
        ws_hypo.Range("F2:N15").Select
        Selection.Copy

        Application.ScreenUpdating = False
        wbk_source.Activate
        ws_fr.Activate
        ws_fr.Select
        ActiveSheet.Paste

        '**************************************************************************************************************************
        '**************************************************************************************************************************
        '**************************************************************************************************************************

        'récupération heure d'ouverture / fermeture / date d'intervention / Gain GF IQ Kwh / an
        nom_fichier_fr = Left(wbk_source.Name, InStrRev(wbk_source.Name, ".") - 1)
        lastligne_led_global = ws_led_global.Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row

        For i = 3 To lastligne_led_global
            nom_fichier_led = ws_led_global.Cells(i, 2).Value
            If nom_fichier_led = nom_fichier_fr Then
                'récupération heure d'ouverture / fermeture / date d'intervention
                ws_fr.Range("F3").Value = ws_led_global.Cells(i, 10).Value
                ws_fr.Range("G3").Value = ws_led_global.Cells(i, 11).Value
                ws_fr.Range("H4").Value = ws_led_global.Cells(i, 5).Value

                'on temporise le temps que les calculs se fassent
                Application.Wait (Now + TimeValue("0:00:01"))

                'Gain GF IQ Kwh / an
                ws_led_global.Cells(i, 30).Value = ws_fr.Range("N14").Value

                'Gain GF IQ Kwh / an avec évolution A-1
                ws_led_global.Cells(i, 34).Value = ws_fr.Range("N15").Value

                Exit For
            End If
        Next i

        'fermeture du fichier sans enregistrer
        wbk_source.Close True

        'passage au fichier suivant
        monFichier = Dir

    Loop

    MsgBox "Traitement terminé !", vbOKOnly, "Relamping LED luminaires 2020"

    Set twb = Nothing
    Set ws_hypo = Nothing
    Set ws_led_global = Nothing
    Set wbk_source = Nothing
    Set ws_fr = Nothing

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub<br>
Rechercher des sujets similaires à "recopier donnees feuille"