Transfert de données

TopNotch63 · 21 Février 2009

Bonjour les Exceleurs,

J'aimerais savoir quelle est d'après vous la façon la plus rapide(efficace) pour transférer des données d'un classeur à un autre.

Voici le code que j'ai écrit pour le faire mais pour 10 000 lignes environ ça prend 30 secondes.

Application.ScreenUpdating = False
Windows("Journal10.xls").Activate
Sheets("Liste").Select

Workbooks.Open Filename:="T:\TransfertJournal.xls"

For X = 1 To 55
Windows("TransfertJournal.xls").Activate: Columns(X).Select: Selection.Copy
Windows("Journal10.xls").Activate: Columns(X).Select: ActiveSheet.Paste
Windows("TransfertJournal.xls").Activate: Application.CutCopyMode = False
Next

Windows("TransfertJournal.xls").Activate
ActiveWorkbook.Close

Windows("Journal10.xls").Activate
Sheets("Liste").Select
Range("A1").Select

On peut sûrement faire mieux.

Merci.

jean paul · 21 Février 2009

Re : Transfert de données

bonsoir
j'utilise ce code de Michel à adapter a ton classeur

Option Explicit

Sub ImporterDepuisPlusieursClasseurs()
Dim Cell As Range
Dim Y As Byte

For Each Cell In Range("A1:A4")'nom des classeur
For Y = 2 To 5
With ActiveSheet.Cells(Cell.Row, Y)
.FormulaArray = "='" & ThisWorkbook.Path & "\[" & Cell & "]" & "Feuil1" & "'!" & Cells(1, Y - 1).Address(0, 0)
.Value = .Value
End With
Next Y
Next Cell

End Sub

voir ce lien https://www.excel-downloads.com/threads/importer-valeur-de-classeur-vers-un-seul.17866/

a+

vbacrumble · 21 Février 2009

Re : Transfert de données

Bonsoir

Testé sur 10000 lignes (environ 3 secondes)

Adapter le nom du répertoire et les noms des feuilles avant de tester
la macro.

Code:

Sub atester()
Dim classeurdestination  As Workbook
Dim classeursource As Workbook
Dim fs As Worksheet
Dim fd As Worksheet
tps = Timer
Application.ScreenUpdating = False
Set classeurdestination = ThisWorkbook

Workbooks.Open ("C:\Temp\Transfertjournal.xls")
Set classeursource = ActiveWorkbook
Set fs = classeursource.Sheets("Journal")
Set fd = classeurdestination.Sheets("Liste")

'fs.UsedRange.Copy fd.Range("a1")
fs.Range("A1:BC" & [BC65536].End(xlUp).Row).Copy fd.Range("a1")
Application.CutCopyMode = False
classeursource.Close

classeurdestination.Sheets("Liste").Activate
Range("A1").Select

MsgBox Timer - tps
Application.ScreenUpdating = True
Set fd = Nothing
Set fs = Nothing
Set classeurdestination = Nothing
Set classeursource = Nothing
End Sub

A+

TopNotch63 · 21 Février 2009

Re : Transfert de données

Je test les 2 versions et je vous en reparle.

Merci beaucoup.

Transfert de données

TopNotch63

XLDnaute Nouveau

jean paul

XLDnaute Junior

vbacrumble

XLDnaute Accro

TopNotch63

XLDnaute Nouveau

Discussions similaires