XL 2010 Récupérer les données de plusieurs fichiers pour un nom de feuille donné

zebanx à dit:

Bonjour JVOS, le forum

Un essai.

Je n'arrivais pas à supprimer les lignes vides à partir de la copie de la feuille de départ (était-ce parce c'était un tableau?...) donc suis partie d'une feuille "modele" simple. Et là ça fonctionne bien (Sans mise en forme).

xl-ment
zebanx

Cliquez pour agrandir...

Roblochon à dit:

Bonjour,

Si vous êtes certain que la feuille existe dans le classeur externe, pour l'importation des données cette ligne devrait le faire:

VB:

ThisWorkbook.Sheets(BE).Range("A2:D20").Value = ActiveWorkbook.Sheets(BE).Range("A2:D20").Value

Et pour la suppression il y a une erreur de syntaxe:
Range("A1").SpecialCells(xlCellTypeBlanks).EtireRow.Delete au lieu de
Range("A1").SpecialCells(xlCellTypeBlanks).EntireRow.Delete


Bon après-midi

Edit: bonjour @zebanx

Cliquez pour agrandir...

Roblochon à dit:

Bonjour,

Chez moi cela fonctionne correctement avec le premier fichier puisque la deuxième n'a pas les bons noms de feuilles....

VB:

ThisWorkbook.Sheets(BE).Range("A2:D20").Copy.Value = ActiveWorkbook.Sheets(BE).Range("A2:D20").Value

Au sujet de : Range("A1").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ne retournera au mieux que la ligne de A1 et si A1 n'est pas vide, une erreur.
SpecialCells lève toujours une erreur quand il n'y pas de cellule correspondante.


Bonne soirée

Cliquez pour agrandir...

Roblochon à dit:

Re,

Dernière tentative. Cette macro fonctionne sur les classeurs donnés.
Elle contient deux nouvelles Variables : wsSource (Feuille source des données) et plageSource (cellules à récupérer)
Elle tente d'ouvrir le classeur n et teste si la feuille est présente
Si la feuille est présente, elle calcule le nombre de lignes de données à importer et fait l'import des valeurs.
Attention: Vous avez à faire à des Tableaux structurés (ListObjects) qui normalement se traitent différemment en vba pour l'ajout de lignes.
Pour la copie des données c'est pas bien grave mais pour le collage c'est autre chose.

Je n'ai pas le temps de voir tout ça ce soir on verra plus tard

VB:

Sub Nvlle_Feuille()
    Dim BE As Variant
    Dim I As Integer
    Dim sRep As String
    Dim sFichier As String
    Dim wsSource As Worksheet
    Dim plageSource As Range
    Dim count As Long
    ActiveSheet.Unprotect ("joker")
    Application.ScreenUpdating = False
    sRep = ThisWorkbook.Path & "\JVOS"      'Boîte de dialogue pour choisir répertoire ChoisirRepertoire & "\"
    BE = "S23"
    sFichier = Dir(sRep & "\*.xlsx")
    Do While sFichier <> ""
        Workbooks.Open sRep & "\" & sFichier  'ouvrir le fichier
        ' vérifier que la feuille existe dans le fichier source
        On Error Resume Next
        Set wsSource = ActiveWorkbook.Sheets(BE)
        On Error GoTo 0
        If Not wsSource Is Nothing Then
            'Compter le nombre de lignes ayant des données dans la colonne A de la source
            count = Application.CountA(wsSource.Range("A2:A20"))
            If count > 0 Then
                Set plageSource = wsSource.Range("A2").Resize(count, 4)
                With ThisWorkbook.Sheets(BE).Range("A2").ListObject
                    For I = 1 To count
                        .ListRows.Add().Range.Value = plageSource.Rows(I).Cells.Value
                    Next
                End With
            End If
            Set wsSource = Nothing
        End If
        ActiveWorkbook.Close savechanges:=False
        sFichier = Dir   'trouve le prochain fichier
    Loop
    Application.ScreenUpdating = True

    ActiveSheet.Protect ("joker")
End Sub

Bonne soirée

Cliquez pour agrandir...

Roblochon à dit:

Bonjour,

"ça coince" ne nous dit rien sur ce qui coince! Quel message, quelle erreur! C'est aussi à vous d'adapter ce qu'on vous donne en étudiant chaque ligne de code et en vous aidant de la touche F1. Sélectionner un mot clef vba (comme Dir par exemple) et faites appel à F1.

Pour "S23", j'avais bien compris que les semaines changeaient. Pour les tests nous n'avons pas besoin de tous les faire, c'est pourquoi, de votre macro je n'ai gardé que ce qui me permettait de tester ce qui est en relation à votre question.

A ce propos, si vous voulez progresser dans l'apprentissage de VBA, je vous suggère, lorsque que vous avez un projet, comme celui-ci, de le décomposer en plusieurs étapes. Par exemple faire en premier la liste des fichiers du répertoire, voir si tout roule et éventuellement où "ça coince".
Une fois que cette étapes tourne sans erreur, passer à la suivante, ouvrir un fichier excel après avoir vérifier qu'il n'est pas déjà ouvert.
Ensuite chercher un feuille dans un classeur, si elle existe.
Comment récupérer une plage de cellule ou en retenir les valeurs.
Comment les transmettre dans un tableau structuré.
etc
Chaque étape étant acquise et fonctionnelle, passez à la suivante. Si vous voulez tout faire et obtenir en même temps, vous perdrez du temps et ne comprendrez pas ce que vous faites.

Pour ne pas vous laisser seul, voici un petit module dont vous pourrez éventuellement vous servir:

VB:

Sub test()
    Dim fichiers As Variant
    Dim i As Long
    Debug.Print "--- Liste des noms préfixés"
    ' Liste des noms préfixés du nom du répertoire
    fichiers = ListeFichiers(ThisWorkbook.Path, "*.xls?")
    If Not IsEmpty(fichiers) Then
        For i = 1 To UBound(fichiers)
            Debug.Print fichiers(i)
        Next
    End If
    Debug.Print "-"
    Debug.Print "--- Liste sans préfixe"
    ' Liste des noms non préfixés
    fichiers = ListeFichiers(ThisWorkbook.Path, "*.xls?", False)
    If Not IsEmpty(fichiers) Then
        For i = 1 To UBound(fichiers)
            Debug.Print fichiers(i)
        Next
    End If
End Sub

'
' Procédure ajoutant si besoin
' le séparateur final à un nom de répertoire
' le paramètre 'Répertoire' étant passé par référence
' sa valeur est modifiée
'
Sub AjouteSéparateur(ByRef Répertoire As String)
    If Répertoire = "" Then
        Répertoire = CurDir & Application.PathSeparator
    Else
        If Right(Répertoire, 1) <> Application.PathSeparator Then
            Répertoire = Répertoire & Application.PathSeparator
        End If
    End If
End Sub
'
' Function renvoyant un tableau des noms de fichier d'un répertoire
' Paramètre AvecRépertoire: préfixe (par défaut) les noms de fichier par le nom du répertoire.
' Paramètre 'Filtre' permet de ne renvoyer que les fichiers y répondant
' par exemple pour les fichiers excel > 2003 avec ou sans macro:  Filtre = "xls?"
'
Function ListeFichiers(ByVal Répertoire As String, _
                Optional ByVal Filtre As String = ".", _
                Optional ByVal AvecRépertoire As Boolean = True) As Variant
          
    Dim item As String
    Dim i As Long
    Dim res() As String
    AjouteSéparateur Répertoire
    item = Dir(Répertoire & Filtre)
    Do While item <> ""
        i = i + 1
        ReDim Preserve res(1 To i)
        res(i) = Array(item, Répertoire & item)(-AvecRépertoire)
        item = Dir
    Loop
    ListeFichiers = Array(Empty, res)(-(i > 0))
End Function
'
' Fonction renvoyant un classeur dont le nom est passé en paramètre
' S'il n'est pas ouvert, la fonction tentera de l'ouvrir à partir
' du répertoire donné
'
Function OuvrirClasseur(ByVal NomClasseur As String, ByVal Répertoire As String) As Workbook
    AjouteSéparateur Répertoire
    On Error Resume Next
    Set OuvrirClasseur = Workbooks(NomClasseur)
    If OuvrirClasseur Is Nothing Then Set OuvrirClasseur = Workbooks.Open(Répertoire & NomClasseur)
    On Error GoTo 0
FIN:
End Function

Bonne programmation

Cliquez pour agrandir...