J'ai besoin d'aide car aujourd'hui, j'ai une macro vba transfert qui marche bien mais je souhaite la modifier pour que cela soit plus simple.
Aujourd'hui, je lance ma macro et je choisi sur mon disque un fichier (le chemin peut varier) et cela récupère sur les différents onglets de ce classeur les informations souhaitées pour les mettre dans mon fichier excel ouvert sous l'onglet bilan.
Maintenant, je voudrai faire la même chose en pouvant sélectionner n fichiers simultanément et que l'importation est lieu pour les n fichiers en une fois.
Voici dessous ma macro tranfert:
Sub TRANSFERT()
' Déclaration des variables
Dim i As Integer
cheminfichier = Application.GetOpenFilename("Fichiers Excels (*.xlsx), *.xls")
' Si on clique sur Annuler dans la fenêtre, on sort de la boucle
If cheminfichier <> False Then
'Ouverture du classeur source
Workbooks.Open cheminfichier
' Récupération du nom du classeur + extension
For i = Len(cheminfichier) To 1 Step -1
If Mid(cheminfichier, i, 1) = "\" Then Exit For
Next
nomfichier = Mid(cheminfichier, i + 1, Len(cheminfichier))
colone = 3
ligne = 1
compteur = 1
If ThisWorkbook.Sheets("Bilan").Cells(2, colone).Value = "" Then
ThisWorkbook.Activate
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Compound"
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Deshy"
ThisWorkbook.Sheets("Bilan").Columns(colone).ColumnWidth = 25
ThisWorkbook.Sheets("Bilan").Cells(1, colone) = compteur
ThisWorkbook.Sheets("Bilan").Cells(2, colone) = Workbooks(nomfichier).Sheets("Description").Range("C2").Value
ThisWorkbook.Sheets("Bilan").Cells(3, colone) = Workbooks(nomfichier).Sheets("Description").Range("E9").Value
ThisWorkbook.Sheets("Bilan").Cells(4, colone).Interior.ColorIndex = 1
ThisWorkbook.Sheets("Bilan").Cells(8, colone) = Workbooks(nomfichier).Sheets("25°C 80%rH").Range("V81").Value
ThisWorkbook.Sheets("Bilan").Cells(9, colone) = Workbooks(nomfichier).Sheets("30°C 65%rH").Range("V81").Value
ThisWorkbook.Sheets("Bilan").Cells(10, colone) = Workbooks(nomfichier).Sheets("40°C 75%rH ").Range("V81").Value
ThisWorkbook.Sheets("Bilan").Cells(16, colone).Interior.ColorIndex = 1
ThisWorkbook.Sheets("Bilan").Cells(17, colone).Interior.ColorIndex = 27
ThisWorkbook.Sheets("Bilan").Cells(18, colone) = Workbooks(nomfichier).Sheets("Description").Range("C17").Value
ThisWorkbook.Sheets("Bilan").Cells(19, colone).Interior.ColorIndex = 27
ThisWorkbook.Sheets("Bilan").Cells(20, colone).Interior.ColorIndex = 27
ThisWorkbook.Sheets("Bilan").Cells(21, colone).Interior.ColorIndex = 1
ThisWorkbook.Sheets("Bilan").Cells(24, colone).Interior.ColorIndex = 1
' Fermeture du classeur source
Workbooks(nomfichier).Close
' Entrée des inputs
x = Application.InputBox("Entrez le taux de charge cible")
ThisWorkbook.Sheets("Bilan").Cells(5, colone) = x
y = Application.InputBox("Entrez la spécification fournisseur (Standard: 1,5%)")
ThisWorkbook.Sheets("Bilan").Cells(26, colone) = y
Z = Application.InputBox("Entrez la spécification client (Standard: 3%)")
ThisWorkbook.Sheets("Bilan").Cells(27, colone) = Z
End If
End If
'masque les feuilles de data deshy et compound si elles existe
NomFeuille = "Compound"
If FeuilleExiste(NomFeuille) Then
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Sheets(NomFeuille).Visible = 0
Application.DisplayAlerts = True
End If
NomFeuille = "deshy"
If FeuilleExiste(NomFeuille) Then
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Sheets(NomFeuille).Visible = 0
Application.DisplayAlerts = True
End If
End Sub
Merci pour votre aide
Ah oui, je suis novice en VB donc il y a peut etre dans lourdeurs dans cette macro mais je découvre au fur et à mesure
yg_be
Messages postés22720Date d'inscriptionlundi 9 juin 2008StatutContributeurDernière intervention23 avril 20241 476 14 mars 2018 à 21:38
bonsoir, que veux-tu dire précisément par "sélectionner n fichiers simultanément"?
souhaites-tu simplement pouvoir sélectionner plusieurs fichiers (se trouvant dans le même dossier) dans la boite de dialogue?
ou bien souhaites-tu pouvoir faire autre chose?
yg_be
Messages postés22720Date d'inscriptionlundi 9 juin 2008StatutContributeurDernière intervention23 avril 20241 476 Modifié le 14 mars 2018 à 21:56
si j'ai bien deviné, suggestion:
option explicit
Sub TRANSFERT()
' Déclaration des variables
Dim chemins, cheminfichier
chemins = Application.GetOpenFilename("Fichiers Excels (*.xlsx), *.xls", , , , True)
If IsArray(chemins) Then
For Each cheminfichier In chemins
'Ouverture du classeur source
Workbooks.Open cheminfichier
'
' ...
'
Next cheminfichier
End If
End Sub
Modifié le 14 mars 2018 à 21:56
option explicit Sub TRANSFERT() ' Déclaration des variables Dim chemins, cheminfichier chemins = Application.GetOpenFilename("Fichiers Excels (*.xlsx), *.xls", , , , True) If IsArray(chemins) Then For Each cheminfichier In chemins 'Ouverture du classeur source Workbooks.Open cheminfichier ' ' ... ' Next cheminfichier End If End Sub15 mars 2018 à 13:33
Merci beaucoup pour ta réponse, ça marche nickel
Je peux continuer à optimiser mon prog