XL 2013 Copie de données entre 2 feuilles sous conditions

ivan27 · 4 Septembre 2016

Bonjour le forum,

Je vous sollicite car j'ai besoin d'aide pour une copie sous conditions entre 2 feuilles.

J'ai une feuille "origine" dans laquelle je dois prélever des données et une feuille "destination" dans laquelle je vais copier les données prélevées.

Chaque feuille peut contenir plusieurs milliers de lignes.

Les données "origine" doivent être copiées à la suite des données existante dans "destination".

Conditions :

Si dans "origine", colonne A = ABC et colonne D = MON CLIENT alors j'effectue la copie suivante :
colonnes "Origine" vers colonne "Destination"
E vers A
D vers B
J vers C
L vers D

Si dans "origine", colonne A = LAP et colonne D = MON CLIENT alors j'effectue la copie suivante :
colonnes "Origine" vers "Destination"
E vers A
D vers B
J vers E
L vers F

Merci d'avance pour votre aide

Bonne journée à tous

Ivan

joss56 · 4 Septembre 2016

Bonjour

Un essai en pièce jointe avec le filtre avancé.

Jocelyn

Theze · 4 Septembre 2016

Bonjour,

Une piste :

Code:

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim L As Long
  
    'défini la plage sur la colonne A à partir de A2 de la feuille "Origine"
    With Worksheets("Origine")
    
        Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
  
    End With
      
    For Each Cel In Plage
  
        With Worksheets("Destination")
      
            Select Case Cel.Offset(, 3).Value
          
                Case "MON CLIENT"
              
                    L = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'sur colonne A
                    .Cells(L, 1).Value = Cel.Offset(, 4).Value
                    .Cells(L, 2).Value = Cel.Offset(, 3).Value
                  
                    If Cel.Value = "ABC" Then
                  
                        .Cells(L, 3).Value = Cel.Offset(, 9).Value
                        .Cells(L, 4).Value = Cel.Offset(, 11).Value
                  
                    ElseIf Cel.Value = " LAP" Then
                  
                        .Cells(L, 5).Value = Cel.Offset(, 9).Value
                        .Cells(L, 6).Value = Cel.Offset(, 11).Value
                  
                    End If
                  
            End Select
              
        End With
      
    Next Cel
  
End Sub

Modeste · 4 Septembre 2016

Bonjour ivan, joss56, Theze,

Une troisième proposition (avec des tableaux en mémoire):
Ajouter un module standard et y coller ces quelques lignes

VB:

Sub transfert()
Set o = Sheets("origine")
Set d = Sheets("destination")
tabloS = o.[A1].CurrentRegion
ReDim tabloD(1 To UBound(tabloS), 1 To 6)
lig = 1
For i = 2 To UBound(tabloS)
    If tabloS(i, 4) = "MON CLIENT" Then
        tabloD(lig, 1) = tabloS(i, 5)
        tabloD(lig, 2) = tabloS(i, 4)
        If tabloS(i, 1) = "ABC" Then
            tabloD(lig, 3) = tabloS(i, 10)
            tabloD(lig, 4) = tabloS(i, 12)
        ElseIf tabloS(i, 1) = "LAP" Then
            tabloD(lig, 5) = tabloS(i, 10)
            tabloD(lig, 6) = tabloS(i, 12)
        End If
        lig = lig + 1
    End If
Next i
derlig = d.Cells(Rows.Count, 1).End(xlUp).Row + 1
d.Cells(derlig, 1).Resize(lig, 6) = tabloD
End Sub

... Je te laisse le soin de vérifier si les résultats sont corrects.
Attention: dans tes consignes, D vers B ne semble pas correspondre au contenu de la feuille destination!?

ivan27 · 4 Septembre 2016

Re bonjour le forum, joss56, These, Modeste,

Merci beaucoup pour vos propositions.
Modeste, après vérification la consigne D vers B est correcte et tu y réponds parfaitement.
Theze, les consignes J vers E et L vers F ne fonctionnent pas.
Bon dimanche à tous,

Ivan

Theze · 6 Septembre 2016

Bonjour,

Ca marche mais une petite erreur c'était glissée dans "ElseIf Cel.Value = "LAP" Then" il y avait un espace en trop devant "LAP" :

Code:

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim L As Long
    'défini la plage sur la colonne A à partir de A2 de la feuille "Origine"
    With Worksheets("Origine")
   
        Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
     
    For Each Cel In Plage
        With Worksheets("Destination")
     
            Select Case Cel.Offset(, 3).Value
         
                Case "MON CLIENT"
             
                    L = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'sur colonne A
                   
                    .Cells(L, 1).Value = Cel.Offset(, 4).Value
                    .Cells(L, 2).Value = Cel.Offset(, 3).Value
                 
                    If Cel.Value = "ABC" Then
                 
                        .Cells(L, 3).Value = Cel.Offset(, 9).Value
                        .Cells(L, 4).Value = Cel.Offset(, 11).Value
                 
                    ElseIf Cel.Value = "LAP" Then '<--- ici il y avait un espace en trop
                 
                        .Cells(L, 5).Value = Cel.Offset(, 9).Value
                        .Cells(L, 6).Value = Cel.Offset(, 11).Value
                 
                    End If
                 
            End Select
             
        End With
     
    Next Cel
End Sub

XL 2013 Copie de données entre 2 feuilles sous conditions

ivan27

XLDnaute Occasionnel

Pièces jointes

joss56

XLDnaute Accro

Pièces jointes

Theze

XLDnaute Occasionnel

Modeste

XLDnaute Barbatruc

ivan27

XLDnaute Occasionnel

Theze

XLDnaute Occasionnel

Discussions similaires