Copier dans feuille "Recap"les lignes d'autres feuilles

Le 12/07/2017 à 11:31

Bonjour,

Je dois réaliser une macro et je suis complètement bloqué, je précise que je suis débutant.

Je vous explique ce que doit faire

la macro doit parcourir l'ensemble des feuilles du dossier commandes dans l’onglet suivi et copier les lignes comprise entre A20 et la valeur en colonne A "insérer commande entre ligne .."et les coller dans la feuille "Recap"

En bidouillant et en regardant un peu partout sur le net j'ai réussi à parcourir toutes les feuilles du dossier par contre après je bloque complètement pour copier les lignes et les mettre dans "Recap".

Si dessous mon code pour parcourir les feuilles :

Sub Ouvrir_feuille()

vDossier = "chemin\commande"

' Selectionner une fiche :

LaFiche = Dir(vDossier & "\*.xls*")

' Boucle pour ouvrir les fiches :

Do Until LaFiche = ""

Workbooks.Open Filename:=vDossier & "\" & LaFiche

FicheEnCours = ActiveWorkbook.Name

Windows(FicheEnCours).Activate

ActiveWorkbook.Close savechanges:=False

LaFiche = Dir

Loop

End Sub

Merci d'avance pour votre aide

22commande.zip (33.66 Ko)
Le 12/07/2017 à 14:23

Bonjour Spindral, bonjour le forum,

Essaie comme ça :

Sub Ouvrir_feuille()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("recap") 'définit l'onglet destination OD
CA = "chemin\commande\" 'définit le chemin d'accès CA
F = Dir(CA & "*.xls*") 'définit le premier fichier excel F du dossier ayant CA comme chemin d'accès
Do Until F = "" 'exécute tant qu'il existe des fichiers F
    Workbooks.Open CA & F 'ouvre le fichier F
    Set CS = ActiveWorkbook 'définit le classeur source CS
    Set OS = CS.Worksheets("suivi") 'définit l'onglet source OS
    DL = OS.Cells(Application.Rows.cout, "A").End(xlUp).Row - 1 'définit l'avant dernière ligne éditée DL de la colonne A de l'onglet OS
    Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
    OS.Range("A20:A" & DL).Copy DEST 'copie la plage de l'onglet source et la colle dans DEST
    CS.Close Savechanges:=False 'ferme le classeur source (sans enregistrer)
    F = Dir 'définit le prochain fichier excel F du dossier ayant CA comme chemin d'accès
Loop 'boucle
End Sub
Le 17/07/2017 à 11:30

Bonjour Thautheme,

Merci pour ton retour, quand je test ta macro il ne se passe rien, j'ai l'impression que la boucle ne s’exécute pas. C'est bizarre je suis pourtant sur du chemin d'accès :

Sub Ouvrir_feuille()

Dim CD As Workbook 'déclare la variable CD (Classeur Destination)

Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)

Dim CA As String 'déclare la variable CA (Chemin d'Accès)

Dim F As String 'déclare la variable F (Fichier)

Dim CS As Workbook 'déclare la variable CS (Classeur Source)

Dim OS As Worksheet 'déclare la variable OS (Onglet Source)

Dim DL As Integer 'déclare la variable DL (Dernière Ligne)

Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD

Set OD = CD.Worksheets("recap") 'définit l'onglet destination OD

CA = "D:\commande" 'définit le chemin d'accès CA"

F = Dir(CA & "*.xls*") 'définit le premier fichier excel F du dossier ayant CA comme chemin d'accès

Do Until F = "" 'exécute tant qu'il existe des fichiers F

Workbooks.Open CA & F 'ouvre le fichier F

Set CS = ActiveWorkbook 'définit le classeur source CS

Set OS = CS.Worksheets("suivi") 'définit l'onglet source OS

DL = OS.Cells(Application.Rows.cout, "A").End(xlUp).Row - 1 'définit l'avant dernière ligne éditée DL de la colonne A de l'onglet OS

Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST

OS.Range("A20:A" & DL).Copy DEST 'copie la plage de l'onglet source et la colle dans DEST

CS.Close Savechanges:=False 'ferme le classeur source (sans enregistrer)

F = Dir 'définit le prochain fichier excel F du dossier ayant CA comme chemin d'accès

Loop 'boucle

End Sub

Cordialement,

Le 17/07/2017 à 12:00

Re,

il manque un "\" à la fin du chemin d'accès :

CA = "D:\commande\" 'définit le chemin d'accès CA"
Le 17/07/2017 à 13:50

merci à toi Thautheme,

Effectivement , je viens de restester le code et la "feuille1" s'ouvre par contre après quand j’exécute pas à pas la macro cela me met une "Erreur d'execution 91" : Variable objet ou variable de bloc With non définie au niveau de : Set OS = CS.Worksheets("suivi") 'définit l'onglet source OS

Cordialement,

Spindral

Le 17/07/2017 à 14:28

Re,

c'est que le classeur ouvert ne contient pas d'onglet nommé suivi... Je te rappelle ton premier post :

la macro doit parcourir l'ensemble des feuilles du dossier commandes dans l’onglet suivi...

Pour éviter le planton, quand un fichier ne contient pas d'onglet suivi, modifie le code comme ça :

Sub Ouvrir_feuille()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("recap") 'définit l'onglet destination OD
CA = "D:\chemin\commande\" 'définit le chemin d'accès CA
F = Dir(CA & "*.xls*") 'définit le premier fichier excel F du dossier ayant CA comme chemin d'accès
Do Until F = "" 'exécute tant qu'il existe des fichiers F
    Workbooks.Open CA & F 'ouvre le fichier F
    Set CS = ActiveWorkbook 'définit le classeur source CS
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set OS = CS.Worksheets("suivi") 'définit l'onglet source OS (génère une erreur si c'est onglet n'existe pas)
    If Err > 0 Then 'condition : si une erreur a été générée
        Err.Clear 'supprime l'erreur
        GoTo suite 'va à l'étiquette "suite"
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    DL = OS.Cells(Application.Rows.cout, "A").End(xlUp).Row - 1 'définit l'avant dernière ligne éditée DL de la colonne A de l'onglet OS
    Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
    OS.Range("A20:A" & DL).Copy DEST 'copie la plage de l'onglet source et la colle dans DEST
suite:
    CS.Close Savechanges:=False 'ferme le classeur source (sans enregistrer)
    F = Dir 'définit le prochain fichier excel F du dossier ayant CA comme chemin d'accès
Loop 'boucle
End Sub
Le 17/07/2017 à 14:57

re Thauthème,

merci de ton retour,

C'est bizarre je ne comprends pas, je n'est plus l'erreur 91 , j'ouvre pourtant bien dans un premiers temps le fichier "recap" puis j'exécute la macro qui pointe vers le dossier commande dans ce dossier toutes les feuilles ont 1 onglet "suivi".

Par contre que ce soit avec e le nouveau code et ou l’ancien j'ai maintenant une erreur 438 : "propriété ou méthode non gérée par cet objet DL = OS.Cells(Application.Rows.cout, "A").End(xlUp).Row - 1 'définit l'avant dernière ligne éditée DL de la colonne A de l'onglet OS

Cordialement,

Le 17/07/2017 à 15:02

Bonjour,

Une autre proposition à étudier.

Cdlt.

35commande.zip (42.71 Ko)
Option Explicit

Public Sub Clear_Table()
    With ActiveSheet.ListObjects(1)
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
    End With
End Sub

Public Sub Consoldate_Data()
Dim wb As Workbook
Dim Table As ListObject
Dim strPath As String, strFilename As String
Dim rCell As Range
Dim lastRow As Long
Const LROW As Byte = 21
    Application.ScreenUpdating = False
    Set Table = ActiveSheet.ListObjects(1)
    With Table
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
        Set rCell = .InsertRowRange.Cells(1)
    End With
    strPath = ThisWorkbook.Path & Application.PathSeparator
    strFilename = Dir(strPath & "*.xls*")
    While strFilename <> ""
        If strFilename <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(strPath & strFilename)
            With wb.Worksheets("suivi")
                lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
                .Cells(LROW, 1).Resize(lastRow - LROW + 1, 8).Copy
                rCell.PasteSpecial xlPasteValues
                Application.CutCopyMode = 0
                Set rCell = Table.HeaderRowRange.Cells(1).Offset(Table.ListRows.Count + 1)
            End With
            wb.Close savechanges:=False
            Set wb = Nothing
        End If
        strFilename = Dir
    Wend
    Set rCell = Nothing: Set Table = Nothing
End Sub
Le 17/07/2017 à 15:09

Re, le fil, le forum,

Count pas cout !... Pourtant j'ai arrêté de boire!... Mais bon, je commence demain !...

Le 03/09/2017 à 21:33

Bonjour,

Merci pour vos réponse cela fonctionne correctement

Cordialement,

Spindral

Le 04/09/2017 à 01:53

Bonjour,

Merci et à bientôt.

Cdlt.

Rechercher des sujets similaires à "copier feuille recap lignes feuilles"