Microsoft 365 VBA copier-coller selon conditions

[ptit_ange69]

Bonjour,

Je souhaite mettre en place un suivi des ventes. L'onglet Export sera un fichier téléchargé que je copierai sur celui-ci.
Sur l'onglet "ventes" je souhaite faire une extraction de mon onglet "Export".
Je m'explique: régulièrement je chargerai mon tableau excel dans le fichier Export et je souhaite à partir de mon bouton faire ce copier coller. Ce que j'ai réussi à faire dans ma macro. Cependant, si dans la colonne A la référence commande a déjà été copié, je ne souhaite pas qu'elle le soit à nouveau. Avec le code créé si devait y avoir une modification ca va le copier dans mon onglet "Ventes" car sur celle-ci je souhaite rajouter une colonne par la suite et noter si expédié ou pas.

J'espère avoir été assez clair dans mes explications.
Merci par avance de votre aide.

 

[vgendron]

Hello
une propostion en PJ

 

[Jacky67]

Bonjour,

Je souhaite mettre en place un suivi des ventes. L'onglet Export sera un fichier téléchargé que je copierai sur celui-ci.
Sur l'onglet "ventes" je souhaite faire une extraction de mon onglet "Export".
Je m'explique: régulièrement je chargerai mon tableau excel dans le fichier Export et je souhaite à partir de mon bouton faire ce copier coller. Ce que j'ai réussi à faire dans ma macro. Cependant, si dans la colonne A la référence commande a déjà été copié, je ne souhaite pas qu'elle le soit à nouveau. Avec le code créé si devait y avoir une modification ca va le copier dans mon onglet "Ventes" car sur celle-ci je souhaite rajouter une colonne par la suite et noter si expédié ou pas.

J'espère avoir été assez clair dans mes explications.
Merci par avance de votre aide.

Bonjour à tous ,
Une proposition, avec ton code et ajouter
>>>If IsError(Application.Match(Cel, WsC.[a:a], 0)).......End if

Sub copiePV()
    Application.ScreenUpdating = False

    Dim WsS As Worksheet, WsC As Worksheet
    Dim Cel As Range, C As Range
    Dim LigneAjout As Long

    Application.ScreenUpdating = False

    Set WsS = Worksheets("Export")
    Set WsC = Worksheets("Ventes")

    For Each Cel In WsS.Range("A2:A" & WsS.Range("A" & Rows.Count).End(xlUp).Row)
        If IsError(Application.Match(Cel, WsC.[a:a], 0)) Then '**** Ajouté
            Set C = WsC.Columns(1).Find(Cel, , xlValues, xlWhole)
            LigneAjout = WsC.Range("A" & Rows.Count).End(xlUp).Row + 1

            If Not C Is Nothing Then
                Cel.Resize(, 16).Copy WsC.Range("A" & C.Row)
            Else
                Cel.Resize(, 16).Copy WsC.Range("A" & LigneAjout)
                LigneAjout = LigneAjout + 1
            End If
        End If ' ajouté '*****
    Next Cel
    Set C = Nothing: Set WsS = Nothing: Set WsC = Nothing

    Application.ScreenUpdating = True

End Sub

 

[ptit_ange69]

Hello
une propostion en PJ

Excellent votre proposition avec la mise en forme du tableau. Merci beaucoup.
J'ai une petite question : dans la colonne B, le format de la date sera "19/02/2025 17:23:00" comment faire pour que lors de l'extraction vers l'onglet "vente" on ait seulement "19/02/2025" ?

 

[vgendron]

Hello

remplacer la macro par celle-ci

Sub CopieExtoVentes()
    Dim DicoVentes As Object
    Dim TabExp() As Variant
    Dim TabToCopy() As Variant
    
    Application.ScreenUpdating = False
    
    Set DicoVentes = CreateObject("scripting.dictionary")
    With Sheets("Ventes").ListObjects("t_Ventes")
        For i = 1 To .ListRows.Count
            clé = .DataBodyRange(i, 1)
            If Not DicoVentes.exists(clé) Then
                DicoVentes.Add clé, i
            End If
        Next i
    End With
    
    With Sheets("Export").ListObjects("t_Export")
        TabExp = Application.WorksheetFunction.Transpose(.DataBodyRange.Value2)
    End With
    
    NbLignes = 0
    For j = LBound(TabExp, 2) To UBound(TabExp, 2)
        clé = TabExp(1, j)
        If Not DicoVentes.exists(clé) Then
            NbLignes = NbLignes + 1
            ReDim Preserve TabToCopy(1 To 14, 1 To NbLignes)
            For i = LBound(TabExp, 1) To UBound(TabExp, 1)
                TabToCopy(i, NbLignes) = TabExp(i, j)
            Next i
            
        End If
    Next j
    
    If NbLignes <> 0 Then
        With Sheets("Ventes").ListObjects("t_Ventes")
            ind = .ListRows.Add.Index
            .DataBodyRange(ind, 1).Resize(UBound(TabToCopy, 2), UBound(TabToCopy, 1)) = Application.WorksheetFunction.Transpose(TabToCopy) 'Application.WorksheetFunction.Transpose
        End With
    End If
    
    Set DicoVentes = Nothing
    Application.ScreenUpdating = True
End Sub

et formater la colonne Date au format "Date", et t'assurer que TOUTES les dates sont bien des dates et pas du texte