Message d'erreur sur code récup dernière cellule non vide

Bonjour

Je souhaite récupérer la dernière cellule non vide d'une colonne mais avec le code utilisé j'obtiens un message d'erreur de compilation erreur de syntaxe .

Voici mon bout de code:

Sheets("Feuil1").Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = "='" & Chemin & "[" & Fichier & "]Feuil1'!Range("A" & Rows.Count).End(xlUp).Select

Indépendamment de ce problème, je souhaiterais également récupérer le contenu de cellules à côté (dessus ou dessous ou à gauche ou à droite) de cellules contenant un texte spécifique, le tout pouvant être intégré à mon code ci-dessus.

Je joins ma macro complète qui est fonctionnelle sauf au niveau de la ligne de code ci-dessus.

Option Explicit

Sub ImporterDates()
Dim objShell As Object
Dim objFolder As Object
Dim Chemin As String
Dim Fichier As String

    Set objShell = CreateObject("Shell.Application")
'Ouvre une fenêtre Window pour sélectionner le dossier
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
'Si l'utilisateur annule sans choisir
If objFolder Is Nothing Then
 'message
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
 'sinon
Else
 'Chemin = répertoire choisi
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
'Choix du 1er fichier
    Fichier = Dir(Chemin & "*.xls")
'on boucle sur tous les fichiers excel du répertoire choisi
    Do While Len(Fichier) > 0
      If Fichier <> ThisWorkbook.Name Then
            With Sheets("Feuil1")

'Inscrit le nom des fichiers en colonne A
                Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Fichier
'Inscrit le contenu de la cellule A3 en B
                Sheets("Feuil1").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = "='" & Chemin & "[" & Fichier & "]Feuil1'!A3"

Sheets("Feuil1").Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = "='" & Chemin & "[" & Fichier & "]Feuil1'!Range("A" & Rows.Count).End(xlUp).Select
            End With
        End If
        Fichier = Dir()
    Loop
End If
End Sub

Merci d'avance

Bonjour jp65,

Avec ce code, on ne devrait pas être loin de ce que tu cherches (ne sachant pas ce que tu souhaites vraiment faire) :

Sheets("Feuil1").Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = "='" & Chemin & "[" & Fichier & "]Feuil1'!A" & Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row

Je te laisse essayer de comprendre la différence avec ton code...

Bonjour vba-new

Tout d'abord un grand merci pour ton aide.

Pour ce qui est de comparer les deux codes, malheureusement mon niveau (proche de zéro) en vba ne me permet pas de le faire,

du moins à ce jour.

Je l'ai intégré à ma macro mais celà ne fonctionne pas. Dans les cellules de la colonne C de mon classeur Tri j'obtient

soit des zéros soit (sur un seul des fichiers) le contenu d'une cellule mais ce n'est pas la dernière de la colonne.

Voici le but de ma macro:

Récupérer dans x classeurs xls fermés le contenu de certaines cellules pour les coller dans un classeur récapitulatif "Tri".

Le nom de chaque classeur ce copie bien.

Le contenu des cellules A3 de chaque classeurs se copie bien.

Par contre je bute sur cette dernière cellule non vide des colonnes A de chaque classeurs.

Merci

Une solution serait d'ouvrir d'abord le fichier, récupérer les valeurs, puis fermer le fichier :

Option Explicit

Sub ImporterDates()
    Dim objShell As Object
    Dim objFolder As Object
    Dim Chemin As String
    Dim Fichier As String
    Dim wbkRecap As Workbook, wbkRep As Workbook

    Set objShell = CreateObject("Shell.Application")
    'Ouvre une fenêtre Window pour sélectionner le dossier
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
    'Si l'utilisateur annule sans choisir
    If objFolder Is Nothing Then
        'message
        MsgBox "Abandon opérateur", vbCritical, "Annulation"
        'sinon
    Else
        Set wbkRecap = ThisWorkbook
        'Chemin = répertoire choisi
        Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
        'Choix du 1er fichier
        Fichier = Dir(Chemin & "*.xls")
        'on boucle sur tous les fichiers excel du répertoire choisi
        Do While Len(Fichier) > 0
            If Fichier <> ThisWorkbook.Name Then
                Set wbkRep = Workbooks.Open(Chemin & Fichier)    'on ouvre temporairement le fichier
                With wbkRep.Sheets("Feuil1")

                    'Inscrit le nom des fichiers en colonne A
                    wbkRecap.Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Fichier
                    'Inscrit le contenu de la cellule A3 en B
                    wbkRecap.Sheets("Feuil1").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = .Range("A3")

                    wbkRecap.Sheets("Feuil1").Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = .Range("A" & Rows.Count).End(xlUp)
                End With
                wbkRep.Close False    'on ferme le fichier du répertoire une fois que l'on a récupéré la valeur
            End If
            Fichier = Dir()
        Loop
    End If
End Sub

vba-new

J'ai essayé la macro modifiée, rien n'est copié, mon tableau récapitulatif "Tri" est vide.

Est-ce que le fait d'ouvrir et fermer chaque classeurs peut être bloquant (au niveau mémoire) dans le cas de nombreux classeurs

(1000 voire plus) ?

Je continue à travailler sur ta macro.

jp65 a écrit :

J'ai essayé la macro modifiée, rien n'est copié, mon tableau récapitulatif "Tri" est vide.

jp65 a écrit :

Est-ce que le fait d'ouvrir et fermer chaque classeurs peut être bloquant (au niveau mémoire) dans le cas de nombreux classeurs

(1000 voire plus) ?

Pourquoi autant de fichier ?

Rien n'est copié, le tableau récapitulatif est totalement vide.

Les classeurs sont des résultats de tests électriques réalisés avec un testeur automatique et il est tout à fait possible qu'il y en est plus de mille.

Je ne vois pas trop. Peux-tu me fournir 2 fichiers allégés + ton fichier tri (très allégé) ?

J'ai testé chez moi et ça marche...

Voilà

Le fichier Tri

Et deux classeurs de mon dossier résultat de test.

Merci pour ton appui.

vba-new

C'a y est ça marche.

Je travaillais avec la macro dans un module de VBAProject(PERSONAL.XLSB)

J'ai migré la macro dans ThisWorkbook de VBAProject(Tri.xlsx) et la tout va bien.

Par contre j'en reviens au problème du nombre de classeurs, y a t'il un moyen d'adapter ta macro pour ne pas devoir les

ouvrir en adaptant peut-être ma macro initiale.

De toute façon je ferais des essais en l'état pour voir ce que celà donne avec de nombreux classeurs.

Encore merci vba-new pour ton aide.

Bonne soirée

Ok.

jp65 a écrit :

Par contre j'en reviens au problème du nombre de classeurs, y a t'il un moyen d'adapter ta macro pour ne pas devoir les

ouvrir en adaptant peut-être ma macro initiale.

Je regarde ça demain matin.

Bonne soirée.

Re,

Voici une possibilité en utilisant une connexion ADO aux fichiers fermés :

Sub ImporterDates()
    Dim objShell As Object, objFolder As Object
    Dim Chemin As String, Fichier As String
    Dim wbkRecap As Workbook
    Dim cn As Object    'ADODB.Connection
    Dim rst As Object    'ADODB.Recordset
    Dim shtFile As String, strQuery As String
    Dim derlign As Long

    shtFile = "Sheet1"    'nom de l'onglet des différents fichiers
    Set objShell = CreateObject("Shell.Application")
    'Ouvre une fenêtre Window pour sélectionner le dossier
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
    'Si l'utilisateur annule sans choisir
    If objFolder Is Nothing Then
        'message
        MsgBox "Abandon opérateur", vbCritical, "Annulation"
        'sinon
    Else
        t = Timer
        Set wbkRecap = ThisWorkbook
        'Chemin = répertoire choisi
        Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
        'Choix du 1er fichier
        Fichier = Dir(Chemin & "*.xls")

        'spécification de la requête SQL de comptage
        'compte le nombre de lignes de la base
        strQuery = "SELECT COUNT(*) FROM [" & shtFile & "$]"

        'on boucle sur tous les fichiers excel du répertoire choisi
        Do While Len(Fichier) > 0
            If Fichier <> ThisWorkbook.Name Then

                Set cn = CreateObject("ADODB.Connection")    'late binding pour éviter l'activation de la référence ADO

                'initie la chaîne de connexion
                With cn
                    .Provider = "Microsoft.Jet.OLEDB.4.0"
                    .ConnectionString = "Data Source=" & Chemin & Fichier & _
                                        ";Extended Properties=Excel 8.0;"
                    .Open
                End With

                Set rst = cn.Execute(strQuery)
                'nombre de ligne à partir de la requête SQL prédéfinie
                derlign = rst.Fields(0).Value + 1

                'on vide les variables
                cn.Close
                Set rst = Nothing
                Set cn = Nothing

                With wbkRecap.Sheets("Feuil1")
                    'Inscrit le nom des fichiers en colonne A
                    .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Fichier
                    'Inscrit le contenu de la cellule A3 en B
                    .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = "='" & Chemin & "[" & Fichier & "]" & shtFile & "'!A3"
                    'Inscrit le contenu de la dernière ligne de la colonne A en C
                    .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = "='" & Chemin & "[" & Fichier & "]" & shtFile & "'!A" & derlign
                End With

            End If
            Fichier = Dir()
        Loop
    End If
    MsgBox Timer - t
End Sub

La difficulté était de récupérer la dernière ligne des différents fichiers.

Dans ce code, on récupère la dernière ligne de la feuille Sheet1 et non de la colonne A.

A priori, si tous les fichiers conserve la même structure, cela devrait revenir au même...

L'exécution de ce code sur 128 fichiers prend environ 6 secondes. A toi de tester. J'ai laissé le chrono.

Bonjour vba-new

J'ai essayé la macro et j'ai un message d'erreur d'exécution 3706 avec arrêt de la macro sur " .Open"

Faut il une librarie ActiveX bien déterminée?

Vu mes soucis sur la précédente macro, faut il la placer dans un endroit spécifique (module, feuille...).

Vu quelle fonctionne chez toi il doit bien avoir un truc.

Je précise au cas où que je suis sous excel 2010.

Merci

Re,

Normalement il faut activer la référence "Microsoft ActiveX Data Objects x.x Library" (fenêtre VBA / Outils / Références).

Cependant, dans mon code, j'ai utilisé une déclaration des variables objet en Late binding (à l'inverse de Early binding), le principal avantage étant de rendre facultatif l'activation des références... bien que cela ralentisse un peu le code.

Dans ton cas, je ne sais pas pourquoi ça ne marche pas. Quelle dis le message d'erreur ?

Bonjour vba-new

Voici le message d'erreur;

Erreur d'exécution '3706':

Impossible de trouver le fournisseur. Il est peut-être mal installé

Et donc la macro s'arrête et surligne en jaune le code .Open

J'essaye encore.

A bientôt

Bonjour à tous

Après moult recherches sur internet il semble que les personnes confrontées à ce genre de message aient des soucis

pour se connecter à un réseau.

Personnellement je ne suis pas en réseau et donc je ne comprends toujours pas ce qui se passe.

Heureusement j'ai toujours sous la main la macro initiale de Vba-new (avec ouverture de tous les classeurs) qui fonctionne super bien

même si il y a un risque de saturation de la mémoire.

Bonne soirée

Bonjour jp65,

Même en activant la référence "Microsoft ActiveX Data Objects x.x Library" (fenêtre VBA / Outils / Références) tu as toujours l'erreur ?

Essaie avec cette macro (utilisation de DAO) :

Sub ImporterDates()
    Dim objShell As Object, objFolder As Object
    Dim Chemin As String, Fichier As String
    Dim wbkRecap As Workbook
    Dim cn As Object
    Dim db As Object    'DAO.Database
    Dim rst As Object    'DAO.Recordset
    Dim shtFile As String, strQuery As String
    Dim derlign As Long

    shtFile = "Sheet1"    'nom de l'onglet des différents fichiers
    Set objShell = CreateObject("Shell.Application")
    'Ouvre une fenêtre Window pour sélectionner le dossier
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
    'Si l'utilisateur annule sans choisir
    If objFolder Is Nothing Then
        'message
        MsgBox "Abandon opérateur", vbCritical, "Annulation"
        'sinon
    Else
        t = Timer
        Set wbkRecap = ThisWorkbook
        'Chemin = répertoire choisi
        Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
        'Choix du 1er fichier
        Fichier = Dir(Chemin & "*.xls")

        'spécification de la requête SQL de comptage
        'compte le nombre de lignes de la base
        strQuery = "SELECT COUNT(*) FROM [" & shtFile & "$]"

        'on boucle sur tous les fichiers excel du répertoire choisi
        Do While Len(Fichier) > 0
            If Fichier <> ThisWorkbook.Name Then

                Set cn = CreateObject("DAO.DBEngine.36")
                Set db = cn.Workspaces(0).OpenDatabase(Chemin & Fichier, True, True, "Excel 8.0;HDR=YES;")
                Set rst = db.OpenRecordset(strQuery)

                'nombre de ligne à partir de la requête SQL prédéfinie
                derlign = rst.Fields(0).Value + 1

                'on vide les variables
                Set cn = Nothing: Set db = Nothing: Set rst = Nothing

                With wbkRecap.Sheets("Feuil1")
                    'Inscrit le nom des fichiers en colonne A
                    .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Fichier
                    'Inscrit le contenu de la cellule A3 en B
                    .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = "='" & Chemin & "[" & Fichier & "]" & shtFile & "'!A3"
                    'Inscrit le contenu de la dernière ligne de la colonne A en C
                    .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = "='" & Chemin & "[" & Fichier & "]" & shtFile & "'!A" & derlign
                End With

            End If
            Fichier = Dir()
        Loop
    End If
    MsgBox Timer - t
End Sub

Bonjour vba-new et le forum

Oui effectivement j'ai activé le contrôle active X.

Par contre en faut il un bien particulier et si oui lequel car dans la liste déroulante j'en ai tout un choix.

Je teste cette nouvelle macro.

Merci une fois de plus vba-new pour ton soutien

Re

J'ai testé la dernière macro.

J'obtient un message d'erreur:

Erreur d'exécution '429':

Un composant ActiveX ne peut pas créer d'objet

Au niveau du code

Set cn = CreateObject("DAO.DBEngine.36")

Peux-tu me dire ce qui est installé ici : C:\Program Files (x86)\Common Files\microsoft shared\DAO ou C:\Program Files\Common Files\microsoft shared\DAO

Voilà

Dans C:\Program Files (x86)\Common Files\Microsoft Shared\DAO

dao360.dll

Dans C:\Program Files\Common Files\microsoft shared\dao

rien