VBA copier cellule vers autre feuille
Bonjour,
J'ai un onglet nomé SCHEDULE, dans cet onglet se trouve un tableu 2D, j'ai besoin de copier certaine valeur pour les copier dans 2 autres feuilles : SAP HEADER et SAP DETAIL. Il faut respecter l'ordre croissant de la colonne "Order". Certaine valeur qui était organisé en colonne doivent être remis en ligne.
Ce n'est pas trés évident à exprimer par écrit, j'ai donc joint un fichier pour expliquer mon besoin .
Merci de votre aide
Bonjour,
Aprés une bonne nuit de sommeil,J'ai trouvé la solution, du moins je ne suis plus trés loin. ( avec des codes retrouvés dans de vieux fichiers.)
Bonjour
Le code semble bon. J'ai remanié quelque peu. Les deux codes complet à utiliser peuvent être ceux ci
Option Explicit
Sub CollerDansSapHEADER()
Dim fSH As Worksheet, fs As Worksheet
Dim i As Integer, dl As Integer, k As Integer
Dim dico As Object
Dim tabloS()
Dim tabloR(), tabloO()
Set fSH = Sheets("SAP HEADER")
Set fs = Sheets("SCHEDULE")
dl = fs.Range("B" & fs.Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
'tabloO = Range("Durée_normale[Ordre]")
tabloO = fs.Range("B2:B" & dl + 1)
'tabloS = fs.Range("Durée_normale[SCH Date]")
tabloS = fs.Range("Q2:Q" & dl + 1)
Set dico = CreateObject("Scripting.Dictionary")
k = 0
For i = 1 To UBound(tabloO, 1)
If Not dico.exists(tabloO(i, 1) & tabloS(i, 1)) Then
ReDim Preserve tabloR(1 To 4, 1 To k + 1)
tabloR(1, k + 1) = tabloO(i, 1)
tabloR(3, k + 1) = tabloS(i, 1)
tabloR(4, k + 1) = tabloS(i, 1)
k = k + 1
End If
dico(tabloO(i, 1) & tabloS(i, 1)) = ""
Next i
fSH.Range("A1").CurrentRegion.Offset(1, 0).ClearContents
fSH.Range("A2").Resize(UBound(tabloR, 2), 4) = Application.Transpose(tabloR)
End Sub
Sub CollerSAPDetail()
' suppose feuille schedule triée sur la colonne 1 et 4
Dim ws1 As Worksheet, ws2 As Worksheet
Dim dlws1 As Integer, dlws2 As Integer
Dim i As Integer, k As Integer, c As Byte
Dim oldo
Set ws1 = Sheets("schedule")
Set ws2 = Sheets("SAP DETAIL")
dlws2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row 'dlws2 dernière ligne de ws2
ws2.Rows("2:" & dlws2).ClearContents 'on nettoie la la feuille ws2
With ws1
dlws1 = .Cells(.Rows.Count, 1).End(xlUp).Row 'dlws1 dernière ligne de ws1
oldo = "" ' numéro et operation précédent
For i = 2 To dlws1 'on parcourt toutes les lignes ws1 à partir de la ligne 2
If .Cells(i, 2) & .Cells(i, 5) <> oldo Then 'si numéro et opération <> numéro ligne précédente
dlws2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1 'dlws2 dernière ligne de ws2
ws2.Cells(dlws2, 1) = .Cells(i, 2) 'numéro
ws2.Cells(dlws2, 2) = .Cells(i, 5) 'opération
oldo = .Cells(i, 2) & .Cells(i, 5) '
c = 2 ' numéro de colonne sur ws2 pour les primes
End If
c = c + 2 'on passe à la colonne suivante pour la prime
ws2.Cells(dlws2, c) = .Cells(i, "P") 'type de prime
ws2.Cells(dlws2, c + 1) = .Cells(i, "H") 'montant de la prime
Next i
End With
End SubCordialement
Merci Dan je vais regarder cela et je te tiens informé du résultat
Bonjour. Ok