Importer de données dans un classeur

[steph71]

Bonsoir à tous,

je planche depuis quelques jours sur un besoin particulier.
J'ai deux classeurs excel A et B
J'aimerais importer dans la feuille 1 du classeur B toutes les données de la feuille 1 du classeur A via un bouton placé sur cette feuille 1.
Et je coince.
J'ai réussi un début de quelque chose mais pour des raisons que j'ignore l'import n'est pas fiable et certaines données ne sont pas importées.

Quelqu'un aurait il déjà été confronté à ce besoin ?

Voilà ma macro actuelle

'import du contenu de la feuille 'BASE' du fichier MASQUE AG_Saisie
'(seules les données sont importées, pas les mises en forme)

Sub TestQuery()
fich$ = '\\\\Uf47-015\\TITEXP-C\\Emetteurs Central m\\Assemblées\\Statistiques\\Masque_AG_Saisie.xls'
Feuille$ = 'BASE'
QueryWorksheet fich, Feuille
End Sub

Public Sub QueryWorksheet(NomFichier$, Feuille$)
'nécessite une référence à la librairie Microsoft ActiveX Data Object 2.x Library

Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String

' Crée la chaîne de connexion
szConnect = 'Provider=Microsoft.Jet.OLEDB.4.0;' & _
'Data Source=' & NomFichier & ';' & _
'Extended Properties=Excel 8.0;'

szSQL = 'SELECT * FROM [' & Feuille & '$];'

Set rsData = New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText

''' Vérifie qu'on a bien reçu des données
If Not rsData.EOF Then
Sheets('BASE').Range('A1').CopyFromRecordset rsData
Else
MsgBox 'Aucun enregistrement renvoyé.', vbCritical
End If

''' On nettoie pour finir...
rsData.Close
Set rsData = Nothing

 

[Blunet]

Salut Stéphane,
Pourquoi ne pas simplement copier les données du classeur A vers B ? Ca fait le même boulot !

Code à adapter
Public Sub Import()
Dim Chemin$

Chemin = 'C:\\Documents and Settings\\xxx\\Bureau\\Nouveau dossier 2\\Transpose.xls'
Workbooks.Open Filename:=Chemin
Workbooks('Transpose').Worksheets('Feuil1').Range('A1:IV65536').Copy _
Destination:=Workbooks('Classeur2').Worksheets('Feuil1').Range('A1')
Workbooks('Transpose').Close SaveChanges:=False
End Sub

Ciao