Extraire une feuille d'un classeur fermé vers un classeur ouvert

Bonjour à tous,

Je souhaite copier une feuille d'un classeur fermé dans un classeur ouvert. Ayant des connaissances assez limitées en VBA, j'ai essayé de lire des tutoriels ( le silkyroad sur développez.net) mais sans réel succès. Par ailleurs, j'ai trouvé sur le forum un petit bout de code qui permet d'atteindre mon objectif.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Sub Test()
 
    Dim ConCL As Object
    Dim Rs As Object
    Dim FeuilleDest As Worksheet
    Dim NomFichier As String
    Dim FeuilleSource As String
    Dim Plage As String
 
    'chemin et nom du classeur cible
    NomFichier = "D:\Users\ighilahrizrya\Desktop\SRM 2018 11 27 22H30.xlsm"
 
    'plage à récupérer
    Plage = "A:Z"
 
    'nom de la feuille où on doit récupérer les valeurs, à adapter...
    FeuilleSource = "Feuil1"
 
    'connexion au classeur
    ConnexionCLasseur ConCL, NomFichier, Rs
 
    'effectue la récup
    With Rs
 
        .CursorType = 1
        .LockType = 3
        .Open "SELECT * FROM `" & FeuilleSource & "$" & Plage & "` ", ConCL
 
        If Not Rs.EOF Then
 
            Set FeuilleDest = ActiveWorkbook.Worksheets("Feuil1")
 
            FeuilleDest.Range("A1").CopyFromRecordset Rs
 
        Else
 
            'si la feuille est vide...
            MsgBox "Aucun enregistrement renvoyé.", vbCritical
 
        End If
 
    End With
 
    ConCL.Close
 
    Set Rs = Nothing
    Set ConCL = Nothing
 
End Sub
 
'Sub de connexion (séparée ici pour plus de lisibilité)
Private Sub ConnexionCLasseur(ConnexCL As Object, _
                              Fichier As String, _
                              Optional Rs)
 
    'création de l'objet en relation tardive (évite de cocher la référence)
    Set ConnexCL = CreateObject("ADODB.Connection")
 
    'si demandé, crée l'objet pour le jeu d'erregistrements
    If Not IsMissing(Rs) Then
        Set Rs = CreateObject("ADODB.Recordset")
    End If
 
    'ouvre la connexion
    ConnexCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & Fichier & ";" & _
              "Extended Properties=""Excel 8.0;HDR=NO;IMEX= 2;"""
 
End Sub

Des que je lance la macro, une erreur s'affiche :
' -2147467259 (80004005)'
External table is not in the format expected

Des que je clique sur débogage, une partie du code est en surbrillance :

Code:

1
2
3
ConnexCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & Fichier & ";" & _
              "Extended Properties=""Excel 8.0;HDR=NO;IMEX= 2;"""

Je travaille avec la version Excel 2013. J'ai par ailleurs activé le Microsoft Active x Data objects.
Il me semble que le problème vient du fait que le classeur cible ( celui ou je vais récupérer mes données) n'est pas au bon format.
Plus précisément, il s'agit d'un classeur avec une seule feuille. Dans celle ci il y a une colonne et une ligne avec des noms et pour chaque couple ligne-colonne correspond une valeur numérique. En gros il s'agit d'une matrice.

Si l'un de vous à la reponse, ca m'aiderait beaucoup pour mon travail.
Merci d'avance :)

bonsoir
Pour faire cette tache je fais avec :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub importProdVte()
Dim wkA As Workbook, wkB As Workbook
Dim chemin As String, fichier As String
Dim j As Long
Application.ScreenUpdating = False
Set wkA = ThisWorkbook
chemin = "Z:\TRAVAUX COMPTABLES BNA\Controle de Gestion\"
fichier = "RAPPORT JOURNALIER.xlsx"
Workbooks.Open chemin & fichier
Set wkB = ActiveWorkbook
 j = wkB.Sheets("Alf3").Range("A" & Rows.Count).End(xlUp).Row
wkA.Sheets("Vente").Range("C1:G" & j).Value = wkB.Sheets("Alf3").Range("D1:H" & j).Value
wkA.Sheets("Vente").Range("A1:B" & j).Value = wkB.Sheets("Alf3").Range("L1:M" & j).Value
 
wkB.Close True
 
 Application.ScreenUpdating = True
 
End Sub

Bonjour,

Merci pour ta réponse. Cependant, des que je lance la macro (en adaptant les chemins d'accès), il me sort une erreur disant :

Citation:

l'indice n'appartient pas à la sélection

et il me surligne cette ligne de code :

Code:

j = wkB.Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row

Sais tu pourquoi ?

Merci

Finalement c'est bon, j'ai reussi à regler le problème
Merci pour ton aide :D