Copier des lignes tableau vers l'autre feuille
Bonsoir
je sollicite votre aide pour un code macro qui me permet de copier des lignes [Les valeurs] d'un tableau de 20 lignes vers un autre tableau de l'autre feuille du même classeur, en insérant la date de mouvement de la cellule B3 avec toutes les lignes à copier.
Merci par avance.
Bonjour
Essayez la macro suivante
Sub iCopy()
Dim sh1 As Worksheet, sh2 As Worksheet, x As Integer, i As Integer
Dim Art1(), Art2(), LR As Integer, M As Integer
Set sh1 = Sheets("Bon Entree"): Set sh2 = Sheets("JOURNAL ER")
x = sh2.Cells(Rows.Count, 2).End(xlUp).Row + 1
With sh1
Application.ScreenUpdating = False
LR = .Cells(.Rows.Count, 2).End(xlUp).Row
If LR < 26 Then M = .Cells(.Rows.Count, 2).End(xlUp).Row Else M = 25
Art1 = Array("b", "e", "g", "h"):
Art2 = Array("c", "f", "h", "i")
For i = 6 To M
For n = 0 To 3
.Range(Art1(n) & i).Copy
sh2.Range(Art2(n) & x).PasteSpecial xlPasteValues
sh2.Range("b" & x) = Format(CDate(.Range("b3")), "dd-mm-yy")
Next
x = x + 1
Next
End With
Application.ScreenUpdating = True
End Sub
Bonsoir belkacem
Merci d'abord pour l'aide
Après essai, j'ai constaté que les colonnes D, E, G, J ne sont pas copiées
En plus, après la copie, une cellule sur la feuille source resté selectionnée
A+
salut
Quelles sont les colonnes que vous souhaitez copier
belkacem64 a écrit :salut
Quelles sont les colonnes que vous souhaitez copier
Re
Toutes les colonnes du tableau
salut
Essayez ce code
Sub iCopy()
Dim sh1 As Worksheet, sh2 As Worksheet, x As Integer, i As Integer
Dim LR As Integer, M As Integer
Set sh1 = Sheets("Bon Entree"):
Set sh2 = Sheets("JOURNAL ER")
x = sh2.Cells(Rows.Count, 2).End(xlUp).Row + 1
With sh1
Application.ScreenUpdating = False
LR = .Cells(.Rows.Count, 2).End(xlUp).Row
If LR < 26 Then M = .Cells(.Rows.Count, 2).End(xlUp).Row Else M = 25
For i = 6 To M
Range("b" & i).Resize(, 8).Copy
sh2.Range("C" & x).PasteSpecial xlPasteValues
sh2.Range("b" & x) = Format(CDate(.Range("b3")), "dd-mm-yy")
x = x + 1
Next
End With
Application.ScreenUpdating = True
Application.CutCopyMode = True
End Sub
Cette fois-ci c'est impeccable
Un grand merci
Je te souhaite bonne nuit et doux rêve
Cordialement
mes respects
Bonne nuit à vous aussi