Extraction d'un Tableau d'un fichier externe

youky(BJ) à dit:

Bonjour miky
Salut Hasco,

miky voici un code qui fonctionne bien
Si les 2 fichiers ne sont pas dans le même dossier il faut mettre manuellement à . . . chemin=??????le vrai chemin
Fichier ="FichierSource" si le fichier porte un autre nom rectifie
Le classeur source peut être ouvert ou fermé, pas de PB.
Voici le code à placer dans le fichier qui reçoit les données (dans un bouton)
Au lieu de B2 tu peux mettre B3 si tu veux pas les entêtes
Bruno

Code:

Private Sub CommandButton1_Click()
Dim Wb As Workbook
chemin = ThisWorkbook.Path & "\"
fichier = "FichierSource.xls"
Set Wb = GetObject(chemin & fichier)
x = Wb.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Address
Wb.Sheets(1).Range("B2:" & x).Copy Feuil2.[A1]
Wb.Close
End Sub

Cliquez pour agrandir...

Hasco à dit:

re bonjour,

Tu n'as pas non plus trouvé la charte du forum apparament. Sans quoi chacun de tes posts aurait un signe de courtoisie en début ET en fin et ne contiendrait pas de style sms ou télégraphique (pkoi, stp etc.).

En faisant une recherche sur 'classeur fermé' on trouve des choses.

A+

Cliquez pour agrandir...

Private Sub CommandButton2_Click()
Dim chemin, fichier As String
Dim x As Range
Dim Wb As Workbook
chemin = ThisWorkbook.Path & "\"
fichier = "FichierSource.xls"


Set Wb = GetObject(chemin & fichier)
x = Wb.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Address
Wb.Sheets(1).Range("B2:" & x).Copy Feuil2.[A1]
Wb.Close
End Sub

Cliquez pour agrandir...

Hasco à dit:

Bonjour,

remplacer déjà:

Code:

x = Wb.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell ).Address

Par

Code:

Dim adr as String
Set x = Wb.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell )
adr = x.Address

X est une référence à un objet (range) elle s'initialise donc avec Set.
Ou par

Code:

dim x as string
x = Wb.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell ).Address

X est une variable 'String" pouvant contenir l'adresse textuelle de la cellule


A+

Cliquez pour agrandir...

Private Sub CommandButton2_Click()
Dim chemin, fichier As String
Dim x As Range
Dim Wb As Workbook
chemin = ThisWorkbook.Path & "d:\userdata\Stage\08-02-11\Test\Test\"
fichier = "FichierSource.xls"
Set Wb = GetObject(chemin & fichier)
Dim adr As String
Set x = Wb.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell)
adr = x.Address
Wb.Sheets(1).Range("B2:" & x).Copy Feuil2.[A1]
Wb.Close
End Sub

Cliquez pour agrandir...

Hasco à dit:

Bonjour,

Essaie ceci:

Code:

Function GetWorkBook(strFullPathToWorkbook As String) As Workbook
    Dim wkb As Workbook
    'Parcourir la colllection des classeurs ouverts
    For Each wkb In Workbooks
        'Si le chemin du classeur est le même que strFullpathtoworkbook
        If wkb.FullName = strFullPathToWorkbook Then
            'Retourner le classeur
            Set GetWorkBook = wkb
            Exit Function
        End If
    Next
    If wkb Is Nothing Then
        'si le classeur n'a pas été trouvé vérifié qu'il existe sur le disque
        If Dir(strFullPathToWorkbook, vbDirectory) <> "" Then
        ' s'il existe, l'ouvrir
        Set GetWorkBook = Workbooks.Open(strFullPathToWorkbook)
        End If
    End If
End Function
Private Sub CommandButton2_Click()
    Dim chemin, fichier As String
    Dim x As Range
    Dim Wb As Workbook
    Dim adr As String
    chemin = "d:\userdata\Stage\08-02-11\Test\Test\"
    fichier = "FichierSource.xls"
    Set Wb = GetWorkBook(chemin & fichier)
    If Not Wb Is Nothing Then
        Set x = Wb.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell)
        adr = x.Address
        Wb.Sheets(1).Range("B2:" & x).Copy Feuil2.[A1]
        Wb.Close
    Else
        MsgBox "Le classeur n'a pas été trouvé," & vbclf & "vérifiez son chemin et son nom puis recommencez"
    End If
End Sub

Ton chemin n'était pas bon
ThisWorkbook.path est déjà le chemin du classeur qui contient la macro!
A+

Cliquez pour agrandir...

Set x = Wb.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell)
adr = x.Address
Wb.Sheets(1).Range("B2:" & x).Copy Feuil2.[A1]
Wb.Close

Cliquez pour agrandir...