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 , une tonne de merci.

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 ne sais pas si cela est possible,

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