IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Code VBA pour parcourir les feuilles d'un classeur Excel


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre du Club
    Homme Profil pro
    Ingénieur de déploiement réseaux
    Inscrit en
    Octobre 2017
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Mali

    Informations professionnelles :
    Activité : Ingénieur de déploiement réseaux

    Informations forums :
    Inscription : Octobre 2017
    Messages : 8
    Par défaut Code VBA pour parcourir les feuilles d'un classeur Excel
    Bonjour à tous, je suis un débutant sur VBA excel. J'ai des petits soucis avec un code. Si quelqu'un peut me venir en aide.

    En fait, mon problème est le suivant :

    Je souhaite ouvrir 04 classeurs dans des emplacements différents, parcourir les feuilles de chaque classeur et copier des données d'une certaine plage et les coller dans un autre classeur.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    Private Sub Btn_Importer_Click ()
     
    Dim j As String
    Dim Wsht1 As Worksheet
     
    Windows("Rapport_Hebdo_Format.xlsm").Activate
     
    Nom_Fichier_1 = Sheets("Tuning").Cells(6, 2).Value
    Dossier_source_1 = Sheets("Tuning").Cells(8, 2).Value
     
    Nom_Fichier_2 = Sheets("Tuning").Cells(10, 2).Value
    Dossier_source_2 = Sheets("Tuning").Cells(12, 2).Value
     
    Nom_Fichier_3 = Sheets("Tuning").Cells(14, 2).Value
    Dossier_source_3 = Sheets("Tuning").Cells(16, 2).Value
     
    Nom_Fichier_4 = Sheets("Tuning").Cells(18, 2).Value
    Dossier_source_4 = Sheets("Tuning").Cells(20, 2).Value
     
    On Error Resume Next
     
    Application.ScreenUpdating = False
     
    Workbooks.Open Filename:=Dossier_source_1 & Nom_Fichier_1
    Workbooks.Open Filename:=Dossier_source_2 & Nom_Fichier_2
    Workbooks.Open Filename:=Dossier_source_3 & Nom_Fichier_3
    Workbooks.Open Filename:=Dossier_source_4 & Nom_Fichier_4
     
    Windows("Rapport_Hebdo_Format.xlsm").Activate
    Sheets("Tuning").Select
     
    Application.ScreenUpdating = True
     
     
    ' Importer des données d'une feuille du premier classeur et les coller dans le classeur Rapport_Hebdo_Format, feuille Rapport'
    C'est le code ci-dessous qui me donne des soucis.


    Merci d'avance pour cette assistance.


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    Windows("Rapport_Hebdo_Format.xlsm").Activate
    Sheets("Tuning").Select
     
    j = Sheets("Tuning").Cells(7, 2).Value   
     
    Workbooks(Dossier_source_1 & Nom_Fichier_1).Activate
     
    For Each Wsht1 In thisworkbooks
     
        If Wsht1.Name = j Then
     
            range("A5:K5").select
            Selection.copy
     
            Windows("Rapport_Hebdo_Format.xlsm").Activate
            range("A1")
            Paste selection.copy
     
     
        End If
     
     
    Next Wsht1
     
     
     
    End Sub

  2. #2
    Membre Expert
    Profil pro
    Inscrit en
    Février 2007
    Messages
    2 266
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2007
    Messages : 2 266
    Par défaut
    Bonjour,

    et si tu précisais le soucis en question, tu ne crois pas que ça aiderait à t'aider ?

    tu dois le faire suivre de On Error Goto 0 dès que tu n'as plus besoin de suspendre le traitement d'erreur (après l'ouverture des fichiers je suppose).
    Sinon tu peux cacher d'autres erreurs que tu dois corriger car anormales.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    For Each Wsht1 In thisworkbooks
    thisworkbooks est resté en minuscules, ça doit t'alerter. C'est ThisWorkbook
    Et ThisWorkbook est le classeur contenant cette macro, tu veux le ActiveWorkbook je suppose.
    D'ailleurs il faut éviter d'activer les objets lorsque tu peux. Les déclarer dans une variable et travailler avec celle-ci.
    eric

  3. #3
    Membre du Club
    Homme Profil pro
    Ingénieur de déploiement réseaux
    Inscrit en
    Octobre 2017
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Mali

    Informations professionnelles :
    Activité : Ingénieur de déploiement réseaux

    Informations forums :
    Inscription : Octobre 2017
    Messages : 8
    Par défaut
    Éric merci beaucoup pour ces éclaircissements.
    Je veux pour chaque activeWorkbook, vérifier si le nom de la feuille 1 correspond au nom indiqué dans une cellule, sélectionner cette feuille, copier des plages et les coller sur une feuille d'un autre classeur. Existe t-il un code assez simple ?
    Merci d'avance pour vos réponses.

  4. #4
    Expert confirmé Avatar de Patrice740
    Homme Profil pro
    Retraité
    Inscrit en
    Mars 2007
    Messages
    2 478
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Mars 2007
    Messages : 2 478
    Par défaut
    Bonjour,

    Un exemple de code :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    Option Explicit
    Public Sub Btn_Importer_Click()
    '
    Dim wbk As Workbook
    Dim cel As Range
    Dim nom As String
    Dim msg As String
    Dim i As Integer
     
      Set cel = ThisWorkbook.Worksheets("Tuning").Cells(6, 2)
      Application.ScreenUpdating = False
      For i = 1 To 4
        ' Ouvrir le fichier
        nom = cel.Value & cel.Offset(2).Value
        On Error Resume Next
        Set wbk = Workbooks.Open(Filename:=nom)
        On Error GoTo 0
        If Not wbk Is Nothing Then
          ' Copier les données
          Call CopierDonnées(wbk, cel, msg)
          wbk.Close False
        Else
          ' Mémoriser le nom du fichier non trouvé
          msg = msg & vbCrLf & "- fichier « " & nom & " »"
          ' Effacer les anciennes données
          cel.Offset(1, 1).Resize(1, 11).Value = Empty
        End If
        ' Fichier suivant
        Set wbk = Nothing
        Set cel = cel.Offset(4)
      Next i
      Application.ScreenUpdating = True
      If msg > "" Then MsgBox "Non trouvé(s) :" & msg
    End Sub
     
    Private Sub CopierDonnées(wbk As Workbook, cel As Range, msg As String)
    '
    Dim wsh As Worksheet
    Dim nom As String
     
      ' Choisir la feuille
      nom = cel.Offset(1).Value
      On Error Resume Next
      Set wsh = wbk.Worksheets(nom)
      On Error GoTo 0
      If Not wsh Is Nothing Then
        ' Copier les données
        wsh.Range("A5:K5").Copy cel.Offset(1, 1)
      Else
        ' Mémoriser le nom de la feuille non trouvée
        msg = msg & vbCrLf & "- feuille « " & nom & " » du fichier « " & wbk.FullName & " »"
        ' Effacer les anciennes données
        cel.Offset(1, 1).Resize(1, 11).Value = Empty
      End If
     
    End Sub
    Et le fichier correspondant :
    Tuning.xls

  5. #5
    Membre du Club
    Homme Profil pro
    Ingénieur de déploiement réseaux
    Inscrit en
    Octobre 2017
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Mali

    Informations professionnelles :
    Activité : Ingénieur de déploiement réseaux

    Informations forums :
    Inscription : Octobre 2017
    Messages : 8
    Par défaut
    Patrice, merci beaucoup pour ce retour. Je vais l'adapter à mon programme et ensuite je vous reviendrai...

  6. #6
    Membre du Club
    Homme Profil pro
    Ingénieur de déploiement réseaux
    Inscrit en
    Octobre 2017
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Mali

    Informations professionnelles :
    Activité : Ingénieur de déploiement réseaux

    Informations forums :
    Inscription : Octobre 2017
    Messages : 8
    Par défaut
    Bonsoir Patrice,

    J'ai regardé ton code. Ca peut résoudre mon problème mais pourriez vous me guider par rapport au code en boucle pour faire la copie
    d'une plage 1 du classeur 1 et la coller dans une plage d'un classeur A
    d'une plage 2 du classeur 2 et la coller dans une plage d'un classeur A
    d'une plage 3 du classeur 3 et la coller dans une plage d'un classeur A
    d'une plage 4 du classeur 4 et la coller dans une plage d'un classeur A

    Merci d'avance pour tes éclairages.

  7. #7
    Expert confirmé Avatar de Patrice740
    Homme Profil pro
    Retraité
    Inscrit en
    Mars 2007
    Messages
    2 478
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Mars 2007
    Messages : 2 478
    Par défaut
    Citation Envoyé par Dayane86 Voir le message
    Bonsoir Patrice,
    J'ai regardé ton code. Ca peut résoudre mon problème mais pourriez vous me guider par rapport au code en boucle pour faire la copie
    d'une plage 1 du classeur 1 et la coller dans une plage d'un classeur A
    d'une plage 2 du classeur 2 et la coller dans une plage d'un classeur A
    d'une plage 3 du classeur 3 et la coller dans une plage d'un classeur A
    d'une plage 4 du classeur 4 et la coller dans une plage d'un classeur A
    Merci d'avance pour tes éclairages.
    C'est ce que fait le code : il copie la plage A5:K5 de chacun des 4 classeurs vers le classeur qui contient la macro.

    Il est assez facile de l'adapter, encore faudrait-il que tu précises ce que tu voudrais !
    Comment sont définies les plages 1, 2, 3 et 4 ? Vers où dans le classeur destination ?

  8. #8
    Membre du Club
    Homme Profil pro
    Ingénieur de déploiement réseaux
    Inscrit en
    Octobre 2017
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Mali

    Informations professionnelles :
    Activité : Ingénieur de déploiement réseaux

    Informations forums :
    Inscription : Octobre 2017
    Messages : 8
    Par défaut
    Bonjour Patrice, effectivement, c'est ce que fait le code. Mais mon souci maintenant c'est de copier des plages différentes de chaque classeur et les coller sur une autre feuille du classeur qui contient la macro.
    Genre :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    Dim wsh1 As Worksheet
    Dim wsh2 As Worksheet
    Dim wsh3 As Worksheet
    Dim wsh4 As Worksheet
     
    Dim nom1 As String
    Dim nom2 As String
    Dim nom3 As String
    Dim nom4 As String
     
    Set cel = ThisWorkbook.Worksheets("Tuning").Cells(6, 2)
      ' Choisir la feuille
      nom1= cel.Offset(1).Value
      nom2= cel.Offset(5).Value
      nom3= cel.Offset(9).Value
      nom4= cel.Offset(13).Value
       On Error Resume Next
      Set wsh1 = wbk.Worksheets(nom1)
      Set wsh2 = wbk.Worksheets(nom2)
      Set wsh3 = wbk.Worksheets(nom3)
      Set wsh4 = wbk.Worksheets(nom4)
      On Error GoTo 0
      If Not wsh1 Is Nothing Then
        ' Copier les données du classeur 1 et la feuille5
        wsh1.Range("A5:K5").Copy cel.Offset(1, 1)
      Else
        ' Mémoriser le nom de la feuille non trouvée
        msg = msg & vbCrLf & "- feuille « " & nom & " » du fichier « " & wbk.FullName & " »"
        ' Effacer les anciennes données
        cel.Offset(1, 1).Resize(1, 11).Value = Empty
      End If
     
     
      If Not wsh2 Is Nothing Then
        '   Copier les données du classeur 2 et la feuille1
        wsh2.Range("B5:D5").Copy cel.Offset(1, 1)
      Else
        ' Mémoriser le nom de la feuille non trouvée
        msg = msg & vbCrLf & "- feuille « " & nom & " » du fichier « " & wbk.FullName & " »"
        ' Effacer les anciennes données
        cel.Offset(1, 1).Resize(1, 11).Value = Empty
      End If
     
      If Not wsh3 Is Nothing Then
        ' Copier les données du classeur 3 et la feuille1
        wsh3.Range("C5:O5").Copy cel.Offset(1, 1)
      Else
        ' Mémoriser le nom de la feuille non trouvée
        msg = msg & vbCrLf & "- feuille « " & nom & " » du fichier « " & wbk.FullName & " »"
        ' Effacer les anciennes données
        cel.Offset(1, 1).Resize(1, 11).Value = Empty
      End If
     
      If Not wsh4 Is Nothing Then
        '  Copier les données du classeur 4 et la feuille1
        wsh4.Range("A5:O5").Copy cel.Offset(1, 1)
      Else
        ' Mémoriser le nom de la feuille non trouvée
        msg = msg & vbCrLf & "- feuille « " & nom & " » du fichier « " & wbk.FullName & " »"
        ' Effacer les anciennes données
        cel.Offset(1, 1).Resize(1, 11).Value = Empty
      End If
     
     
    End Sub
    A partir de là je souhaite les coller dans le classeur qui contient la macro sur une feuille 2

    Merci d'avance pour les éclairages.

  9. #9
    Expert confirmé Avatar de Patrice740
    Homme Profil pro
    Retraité
    Inscrit en
    Mars 2007
    Messages
    2 478
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Mars 2007
    Messages : 2 478
    Par défaut
    Bonjour,

    Comme tu ne précises toujours pas la destination exacte des données sur la feuille 2, voici une approche plus générique :
    Le fichier : Tuning.xls

    Et le code utilisé (une seule procédure) :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    Option Explicit
    Public Sub Btn_Importer_Click()
    '
    Dim wbkSource As Workbook
    Dim wshSource As Worksheet
    Dim celInfoCopie As Range
    Dim celCible As Range
    Dim nomComplet As String
    Dim nomFeuille As String
    Dim msg As String
    Dim adr As String
     
      Application.ScreenUpdating = False
      ' Première cellule InfoCopie (chemin)
      Set celInfoCopie = ThisWorkbook.Worksheets("Tuning").Cells(6, 2)
      Do While Not IsEmpty(celInfoCopie.Value)
        ' Adresse cellule de destination
        adr = celInfoCopie.Offset(4).Value
        ' Cellule de destination
        Set celCible = ThisWorkbook.Worksheets("Feuil2").Range(adr)
        ' Adresse de la plage à copier
        adr = celInfoCopie.Offset(3).Value
        ' nom complet du fichier source
        nomComplet = celInfoCopie.Value & celInfoCopie.Offset(1).Value
        ' Ouvrir le fichier source
        On Error Resume Next
        Set wbkSource = Workbooks.Open(Filename:=nomComplet)
        On Error GoTo 0
        If Not wbkSource Is Nothing Then
          ' Si le fichier existe, copier les données
          ' - nom de la feuille source
          nomFeuille = celInfoCopie.Offset(2).Value
          ' - définir la feuille
          On Error Resume Next
          Set wshSource = wbkSource.Worksheets(nomFeuille)
          On Error GoTo 0
          If Not wshSource Is Nothing Then
            ' - si la feuille existe, copier les données
            wshSource.Range(adr).Copy celCible
          Else
            ' - si la feuille n'est pas trouvée mémoriser le nom de la feuille
            msg = msg & vbCrLf & "- feuille « " & nomFeuille & " » du fichier « " & wbkSource.FullName & " »"
            ' Effacer les anciennes données
            celCible.Resize(Range(adr).Rows.Count, Range(adr).Columns.Count).Value = Empty
          End If
          ' - fermer le fichier source
          wbkSource.Close False
        Else
          ' Si le fichier n'est pas trouvé, mémoriser le nomComplet du fichier
          msg = msg & vbCrLf & "- fichier « " & nomComplet & " »"
          ' Effacer les anciennes données
          celCible.Resize(Range(adr).Rows.Count, Range(adr).Columns.Count).Value = Empty
        End If
        ' Fichier suivant
        Set wbkSource = Nothing
        Set celInfoCopie = celInfoCopie.Offset(6)
      Loop
      Application.ScreenUpdating = True
      If msg > "" Then MsgBox "Non trouvé(s) :" & msg
    End Sub

  10. #10
    Membre du Club
    Homme Profil pro
    Ingénieur de déploiement réseaux
    Inscrit en
    Octobre 2017
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Mali

    Informations professionnelles :
    Activité : Ingénieur de déploiement réseaux

    Informations forums :
    Inscription : Octobre 2017
    Messages : 8
    Par défaut
    Bonjour Patrice, merci beaucoup pour cette aide précieuse...Le Code fonctionne à merveille.. Je vais le réadapter à mon problème.

Discussions similaires

  1. Réponses: 5
    Dernier message: 21/02/2018, 09h36
  2. [XL-2010] Code VBA pour protéger certaines feuilles d'un classeur
    Par Niko77 dans le forum Conception
    Réponses: 7
    Dernier message: 27/07/2015, 09h06
  3. [XL-2010] Code VBA pour comparer deux feuilles Excel
    Par sam013 dans le forum Excel
    Réponses: 1
    Dernier message: 13/08/2012, 14h53
  4. [SSIS 2K8] Parcourir les feuilles d'un classeur Excel
    Par patriceharel dans le forum SSIS
    Réponses: 3
    Dernier message: 10/02/2009, 16h34

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo