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>