Tableau source- tableau destination

[sebkernoise]

Bonjour,

J'aimerais avoir un peu d'aide.
En effet, j'aimerais automatiser le plus possible, par le biais de macro, une copie de tableaux avec des dimensions variables. Afin de mieux m'expliquer, voici en fichier joint le dilemme.

Merci d'avance à qui pourra m'aider. [file name=SourceDestination.zip size=11940]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/SourceDestination.zip[/file]

 

[flyonets]

Bonsoir
ci joint un code pour realiser une copie de feuille
Public Sub Botablo()
'Pour copier une feuille dans une autre avec un array
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Tablo As Variant, Z As Long, Dlign As Long
Z = 20000: Dlign = 112
Feuil1.Activate: Cells(1, 1).Select
Dlign = Range('A65536').End(xlUp).Row
Tablo = ActiveSheet.Cells(1, 1).Resize(Dlign, Z).Value
Feuil2.Cells(1, 1).Resize(UBound(Tablo, 1), UBound(Tablo, 2)) = Tablo
' Feuil2.Activate: Cells(1, 1).Select
erase tablo
Application.Calculation = xlCalculationAutomatic
End Sub

 

[sebkernoise]

Merci pour votre réponse, mais celle-ci ne se limite qu'à copier une feuille dans le même fichier.
Est-il possible de copier des feuilles contenant des tableaux d'un fichier vers un autre fichier ?

Merci à celui ou celle qui me mettra sur la voie

 

[sebkernoise]

Bonjour,

Pour le moment, j'ai trouvé ça comme code mais j'ai un problème lors du collage.
Quelqu'un peut m'aider SVP.


Sub Import()


Dim maFeuille As Worksheet

ChDir _
'C:\\Documents and Settings\\Propriétaire\\Mes documents\\Tarif'
Workbooks.Open Filename:= _
'C:\\Documents and Settings\\Propriétaire\\Mes documents\\Tarif\\source.xls'

Set maFeuille = Worksheets(1)
maFeuille.Select

ActiveWindow.ScrollWorkbookTabs Position:=xlFirst

Dim maplage As Range
Set maplage = Range('A1:C10')

For i = 1 To maplage.Cells.Count

If maplage.Cells(i).Interior.ColorIndex = 3 Then
maplage.Cells(i).Select
maplage.Cells(i).Copy

Windows('destination.xls').Activate
j = 0
j = j + 1
Cells(j, 1).Select
ActiveSheet.Paste
End If

Next i

End Sub

 

[sebkernoise]

Bonjour,

Pour le moment, j'ai trouvé ça comme code mais j'ai un problème lors du collage.
Quelqu'un peut m'aider SVP.


Sub Import()


Dim maFeuille As Worksheet

ChDir _
'Cocuments and SettingsPropriétaireMes documentsTarif'
Workbooks.Open Filename:= _
'Cocuments and SettingsPropriétaireMes documentsTarifsource.xls'

Set maFeuille = Worksheets(1)
maFeuille.Select

ActiveWindow.ScrollWorkbookTabs Position:=xlFirst

Dim maplage As Range
Set maplage = Range('A1:C10')

For i = 1 To maplage.Cells.Count

If maplage.Cells(i).Interior.ColorIndex = 3 Then
maplage.Cells(i).Select
maplage.Cells(i).Copy

Windows('destination.xls').Activate
j = 0
j = j + 1
Cells(j, 1).Select
ActiveSheet.Paste
End If

Next i

End Sub