Dernière ligne non vide avec GetObject

Bonjour,

Je reviens vers vous pour trouver la solution à mon problème. J’ai absolument besoin de vos expertises.

Je dispose quatre fichiers A.xls , B.xls , C.xls et D.xls.

Dans les quatre fichiers il existe la « feuille 1 » qui est exactement identique pour chaque fichier. Feuille 1 de A est vide les autres non.

Je souhaite copier les lignes non vides de B, C et D dans A. Si par exemple j’ai 10 lignes dans ces trois fichiers, je souhaite avoir 30 lignes dans A.

Je précise que seulement le fichier A est ouvert les autres sont fermés. Je souhaite parcourir alors les trois fichiers fermés pour trouver le nombre de ligne non vide dans la feuille1 de chaque fichier pour les copier dans la feuille1 du fichier A.

J’ai essaye de faire ceci mais cela ne fonctionne pas :

Sub Test()

Dim MonFichier As Workbook
Dim lastLigne, i, j As Integer

j = 4
    Set MonFichier = GetObject("V:\TEST 1\B.xls")

        MonFichier.Worksheets(1).Activated
        lastLigne = MonFichier.Worksheet(1).Range("A65536").End(xlUp).Row
        For i = 4 To lastLigne
            Rows("j:j") = MonFichier.Worksheets(1).Rows("i:i")
            j = j + 1
        Next i

    MonFichier.Close SaveChanges:=False

End Sub

Je vous remercie pour vos suggestions.

Cdt,

Bonjour

Comme tu peux t'en douter, code non testé

Option Explicit

Sub Test()
Dim Chemin As String
Dim Ws As Worksheet
Dim LastLigne As Long, Ligne As Long
Dim I As Byte

  Application.ScreenUpdating = False
  Ligne = 4
  Chemin = "V:\TEST 1\"
  Set Ws = Sheets("Feuille 1")          ' La page "feuille 1" de ce classeur
  For I = 66 To 68    ' code ASCII de B, C et D
    If Dir(Chemin & Chr(I) & ".xls") = "" Then
      MsgBox "Le fichier " & Chr(I) & ".xls est introuvable"
    Else
      With Workbooks.Open(Chemin & Chr(I) & ".xls")
        With .Sheets("Feuille 1")        ' Page "Feuille 1" du classeur que l'on ouvre
          LastLigne = .Range("A" & Rows.Count).End(xlUp).Row
          .Rows("4:" & LastLigne).Copy Ws.Range("A" & Ligne)
          Ligne = Ws.Range("A" & Rows.Count).End(xlUp).Row + 1
        End With
        .Close savechanges:=False
      End With
    End If
  Next I
End Sub

Merci beaucoup,

cette méthode fonctionne parfaitement