VBA : Importer des données d'un classeur dans un autre
Bonjour à tous,
J'ai un problème d'importation des données.
J'ai un classeur ("Traitement") avec 4 feuilles "Données1", "Données2", "Données3" et "Données4", ("Base"). Et je voudrai importer dans chacune de ces feuilles les données qui se trouvent sur la feuille ("Données") d'un autre classeur ("Base"), le principe est des copier certaines colonnes de la feuille "Données" du classeur "Base" et les copier dans les feuilles Données... du classeur "Traitement" (Les colonnes à copier ne sont pas forcement les mêmes et dépendent des feuilles de destination...)
Mon code ci-dessous marche bien si je fais l'importation une à une. Mais je voudrai optimiser le code en regroupant toutes les 4 importations (si possible). c-à-d en une importation de la feuille "Données" du classeur "Base", j'arrive à distribuer les colonnes correspondantes dans chaque feuilles "Données1", "Données2", "Données3" et "Données4" du classeur "Traitement".
Merci d'avance pour votre aide....
Public Function Fichier_Existe(Path As String) As Boolean
If Dir(Path) = "" Then
Fichier_Existe = False
Else
Fichier_Existe = True
End If
End Function
Function ExistanceFichier(NomFichier)
Dim CheminComplet As String
Dim fichier As String, Chemin As String
Chemin = Workbooks(ActiveWorkbook.Name).Path
fichier = NomFichier
CheminComplet = Chemin + "\" + fichier
'MsgBox CheminComplet
'Teste l'existance du fichier Destination
If (Fichier_Existe(CheminComplet)) Then
' Le fichier existe bien et renvoi le chemin complet correct
ExistanceFichier = CheminComplet
Else
' Le fichier n'existe pas et renvoi "ERREUR"
ExistanceFichier = "ERREUR"
End If
End Function
'copier la feuilles donnees concernant les information générales ou personnelles du classeur base et coller dans la feuille Données du classeur Traitement
Sub Import1()
'On Error Resume Next
Dim NomFichierExiste As String
Dim fichier As String
fichier = "Base.xlsx"
NomFichierExiste = ExistanceFichier(fichier)
If StrComp(NomFichierExiste, "ERREUR") Then
Workbooks.Open Filename:=NomFichierExiste
Else
MsgBox "Le fichier " & fichier & " est introuvable. Veuillez vérifier le chemin " & Workbooks(ActiveWorkbook.Name).Path & "", vbOKOnly, "Problème Chemin Ou Fichier"
Exit Sub
End If
' Importer dans Données1
Sheets("Données").Select
Range("A1:S1000").Select
Selection.Copy
Windows("Traitement.xlsm").Activate
Sheets("Données1").Select
Range("A1").Select
ActiveSheet.Paste
Windows("Base.xlsx").Activate
ActiveWorkbook.Close
' Importer dans Données2
Sheets("Données").Select
Range("J1:BB1000").Select
Selection.Copy
Windows("Traitement.xlsm").Activate
Sheets("Données2").Select
Range("A1").Select
ActiveSheet.Paste
Windows("Base.xlsx").Activate
ActiveWorkbook.Close
' Importer dans Données3
Sheets("Données").Select
Range("J1:K1000, BL1:BZ1000").Select
Selection.Copy
Windows("Traitement.xlsm").Activate
Sheets("Données3").Select
Range("A1").Select
ActiveSheet.Paste
Windows("Base.xlsx").Activate
ActiveWorkbook.Close
' Importer dans Données4
Sheets("Données").Select
Range("J1:K1000, V1:AN1000").Select
Selection.Copy
Windows("Traitement.xlsm").Activate
Sheets("Données4").Select
Range("A1").Select
ActiveSheet.Paste
Windows("Base.xlsx").Activate
ActiveWorkbook.Close
End Sub
Bonjour
Avec une simplification du code
A vérifier
Option Explicit
'copier la feuilles donnees concernant les information générales ou personnelles du classeur base et coller dans la feuille Données du classeur Traitement
Sub Import1()
Dim Fichier As String, Chemin As String
Dim Wb As Workbook
Set Wb = ThisWorkbook
Chemin = ThisWorkbook.Path & "\"
Fichier = "Base.xlsx"
If Dir(Chemin & Fichier) = "" Then ' Le fichier n'existe pas
MsgBox "Le fichier " & Fichier & " est introuvable. IL doit être placé dans : " & Chemin & "", vbOKOnly, "Problème Fichier"
Else
Application.ScreenUpdating = False
With Workbooks.Open(Filename:=Chemin & Fichier)
With .Sheets("Données")
.Range("A1:S1000").Copy Wb.Sheets("Données1").Range("A1")
.Range("J1:BB1000").Copy Wb.Sheets("Données2").Range("A1")
.Range("J1:K1000, BL1:BZ1000").Copy Wb.Sheets("Données3").Range("A1")
.Range("J1:K1000, V1:AN1000").Copy Wb.Sheets("Données4").Range("A1")
End With
.Close savechanges:=False
End With
End If
End Sub
Salut Banzai64,
Ton code marche super bien
Mais est-t-il possible de rendre les feuilles "Données1, Données2, Données3 et Données4" invisible après la copie ? Au fait, j'effectue les TCDs sur ces feuilles et presente les resultats sur plusieurs feuilles (contenants les TCDs) que je voudrai les masquer tous en gardant seulement ma page d'accueil et les rendre visible que si on les choisit (à travers le menu) et deviennent invisible (sauf la page d'accueil) une fois le classeur sera fermé.
je suis obligé de me balader avec toutes les feuilles visibles...
Bonsoir
Masques ces feuilles manuellement avant d'appuyer sur le bouton "Import" et laisse les masquer
Bonjour Banzai64,
ça marche pour les feuilles Données1..4, une fois importation faite, je les masque manuellement mais pour les autres feuilles d'affichage des résultats, si je les masque, je ne pourrais pas les ré-afficher en cliquant sur le bouton d'orientation vers la page spécifique..donc il faut peut-être les garder toutes visibles...
Merci pour ton aide
Bonjour
Kers a écrit :je ne pourrais pas les ré-afficher en cliquant sur le bouton d'orientation vers la page spécifique..
Si tu le dis je ne peux pas te contredire, je n'ai pas de fichier avec ce bouton
Bonjour
Désolé de mettre mon grain de sel dans votre discussion
Pour masquer la feuille "RELAIS" dans mon exemple le code est
Sheets("RELAIS").Select
ActiveWindow.SelectedSheets.Visible = False
Pour la faire réapparaître il suffit de remplacer False par True et le tour est joué
Sheets("RELAIS").Select
ActiveWindow.SelectedSheets.Visible = True
C'était pour faire avancer le schmilblick
Bien à vous