XL 2010 une macro pour transférer un tableau

[stefer]

Bonjour,
J'ai un tableau dans la feuil1 et je voudrais avec un bouton pouvoir transférer simplement sur la feuil2 certaine colonne (2à7).
Merci de vos réponses

 

[Dranreb]

Bonsoir.
Comme ça ?

Sub Transfere()
Dim TSrc(), LSrc&, TCbl(), LCbl&, C&
TSrc = Intersect(Feuil1.Rows(4).Resize(1000000), Feuil1.UsedRange).Value
ReDim TCbl(1 To UBound(TSrc, 1), 1 To 6)
For LSrc = 1 To UBound(TSrc, 1)
   If VarType(TSrc(LSrc, 8)) <> vbDate Then
      LCbl = LCbl + 1
      For C = 1 To 6: TCbl(LCbl, C) = TSrc(LSrc, C + 1): Next C: End If: Next LSrc
Feuil2.[A4].Resize(1000000).ClearContents
Feuil2.[A4].Resize(LCbl, 6).Value = TCbl
End Sub

 

[stefer]

Bonsoir,
Oui c'est l'idée merci par contre il y a des ligne qui se multiplie dans la feuil2
Pour vous montrer la feuil1 cest les lignes jaunes qui doivent etre transférées mais certaine se multiplie jai fait plein dessai en changeant les dates et il y a des lignes qui se multiplie.
merci d'avance

 

[Dranreb]

Je ne comprends pas ce que vous voulez dire. Toutes les lignes de la feuille 2 sont vides dans le xlsx joint, sans macro, donc.

 

[stefer]

cest celui la

 

[Dranreb]

Oublié d'effacer le reste de colonnes. Comme ça on efface les lignes entières :

Sub Transfere()
Dim TSrc(), LSrc&, TCbl(), LCbl&, C&
TSrc = Intersect(Feuil1.Rows(4).Resize(1000000), Feuil1.UsedRange).Value
ReDim TCbl(1 To UBound(TSrc, 1), 1 To 6)
For LSrc = 1 To UBound(TSrc, 1)
   If VarType(TSrc(LSrc, 8)) <> vbDate Then
      LCbl = LCbl + 1
      For C = 1 To 6: TCbl(LCbl, C) = TSrc(LSrc, C + 1): Next C: End If: Next LSrc
Feuil2.Rows(4).Resize(1000000).ClearContents
Feuil2.[A4].Resize(LCbl, 6).Value = TCbl
End Sub

 

[stefer]

Merci en tout cas je vais rajouter un bouton pour effacer
Bonne soirée a vous et a bientot

 

[Lone-wolf]

Bonsoir Dranreb

 

[Dranreb]

Bonsoir Lone-wolf