Transfert de données

[TopNotch63]

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]

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]

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.

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]

Re : Transfert de données

Je test les 2 versions et je vous en reparle.

Merci beaucoup.