VBA copier cellule vers autre feuille

8test1.xlsx (106.14 Ko)

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.)

20test1.xlsm (117.37 Ko)

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 Sub

Cordialement

Merci Dan je vais regarder cela et je te tiens informé du résultat

Bonjour. Ok

Rechercher des sujets similaires à "vba copier feuille"