XL 2010 Aide VBA copier collé si condition respecté

[lelebl]

Bonjour à toutes et tous,
Tout d'abord merci de prendre le temps de me lire.
J'ai régulièrement besoin (pour milieu professionnel) de mettre à jour une base de donnée.
Cette base de donnée est égal à => Donnée d'un fichier si une condition est respecté + donnée d'un autre fichier si la condition est respecté.
Sachant que cette base de donnée dois être mis à jour très régulièrement, j'aimerai mettre en place une automatisation de celle-ci (d'où mon besoin de VBA).
Je suis arrivé grâce à une fonction si à savoir si "oui" le critère est respecté ou si "non" le critère n'est pas respecté.
Maintenant, si "oui", j'aimerai copié la ligne (cellule par cellule car les deux bases de donnée n'ont pas le même format).
Afin que vous compreniez mieux mes difficultés, ci-joint un fichier Excel + une esquisse de code que j'ai réalisé (et où je bloque)

Merci d'avance de votre aide, je recherche ici des explications et de l'aide.
'L'objectif de cette macro est en fonction du critère stocké en E, je copie la ligne.

Sub Copier()

' J'ai créer la variable i afin de pouvoir passer toutes les lignes en revue une par une
Dim i As Integer
Dim j As Integer

'J'ai créer la variable JanvierFévrier car je sais que je dois coller la donnée de février après celle de janvier dans le tableau janvierfévrier
With Worksheets("JanvierFévrier")
LastLigJanvierFévrier = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'Je crée la variable dernière fin de ligne de Janvier afin que je test toutes les lignes complètes de Janvier
With Worksheets("Janvier")
  LastLigCNCTest = .Cells(.Rows.Count, "A").End(xlUp).Row
 
  'Me permet de passer en revu de la première ligne à la dernière ligne
For i = 1 To LastLigCNCTest

'Si mon critère est respecté alors

If .Range("K" & i) = "Oui" Then

'La ligne i est = à la dernière ligne non rempli de JanvierFévrier
.Range("M" & i) = .Range("B" & LastLigJanvierFévrier)
'La Ligne i est = à la dernière ligne non rempli de JanvierFévrier
.Range("N" & i) = .Range("A" & LastLigJanvierFévrier)
End If
Next



End With
End Sub

Beaucoup d'amour à tous.
LeLebl

 

[Dan]

Bonjour
Essayez comme ceci :

Sub Copier()
Dim sh As Byte
Dim i As Integer, lig As Integer

With Worksheets("JanvierFévrier")
    lig = .Range("A" & .Rows.Count).End(xlUp).Row
    If lig = 1 Then lig = 2
    .Range("A2:E" & lig).ClearContents
End With
    
For sh = 1 To Sheets.Count
    If Sheets(sh).Name <> "JanvierFévrier" Then
        With Sheets(sh)
            For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
                If UCase(.Range("E" & i)) = "OUI" Then
                    With Worksheets("JanvierFévrier")
                        lig = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                        .Range("A" & lig) = Sheets(sh).Range("A" & i)
                        .Range("B" & lig) = Sheets(sh).Range("C" & i)
                        .Range("C" & lig) = Sheets(sh).Range("B" & i)
                        .Range("D" & lig) = Sheets(sh).Range("D" & i)
                    End With
                End If
            Next i
        End With
    End If

Next sh
End Sub

Attention à votre feuille nommée Janvier + Février qui doit être nommé "JanvierFévrier"

Cordialement

 

[fanch55]

Bonsoir,
Après conversion des tables en tables structurées ,
Classeur à tester .

 

[lelebl]

Bonjour,

Tout d'abord merci de votre aide.
Fanch55, merci mais je n'ai pas tout compris à votre code et je ne suis pas sûre que j'arriveraià l'adapterà mon classeur officiel. (néanmoins super boulot)
Dan, j'arrive à comprendre ce que vous faite, néanmoins, ça ne fonctionne pas...
En effet, sachant que "Janvier" et Février n'ont pas la même structure de tableau (client de Janvier en Colonne B alors que dans février client est en colonne C), comment faire pour ne pas mélanger les colonnes dans JanvierFévruer?
Edit : Tout simplement en faisant de nouveau une boucle.

Merci à tout ceux qui ont participé, veuillez trouver ci-dessous le code final utilisé.

Sub Copier()
Dim sh As Byte
Dim e As Integer
Dim ex As Byte
Dim i As Integer, lig As Integer



With Worksheets("JanvierFévrier")
    lig = .Range("A" & .Rows.Count).End(xlUp).Row
    If lig = 1 Then lig = 2
    .Range("A2:E" & lig).ClearContents
End With
    
For sh = 1 To Sheets.Count
    If Sheets(sh).Name = "Janvier" Then
        With Sheets(sh)
            For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
                If UCase(.Range("E" & i)) = "OUI" Then
                    With Worksheets("JanvierFévrier")
                        lig = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                        .Range("A" & lig) = Sheets(sh).Range("A" & i)
                        .Range("B" & lig) = Sheets(sh).Range("C" & i)
                        .Range("C" & lig) = Sheets(sh).Range("B" & i)
                        .Range("D" & lig) = Sheets(sh).Range("D" & i)
                    End With
                End If
            Next i
        End With
    End If

Next sh
For ex = 1 To Sheets.Count
    If Sheets(ex).Name = "Février" Then
        With Sheets(ex)
        
            For e = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
                If UCase(.Range("E" & e)) = "OUI" Then
                    With Worksheets("JanvierFévrier")
                        lig = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                        .Range("A" & lig) = Sheets(ex).Range("A" & e)
                        .Range("B" & lig) = Sheets(ex).Range("B" & e)
                        .Range("C" & lig) = Sheets(ex).Range("C" & e)
                        .Range("D" & lig) = Sheets(ex).Range("D" & e)
                        End With
                    End If
                Next e
            End With
        End If
    
    Next ex


End Sub

LeLebl !

 

[Dan]

Juste déoslé j'ai été trop vite...
Pas besoin de faire deux boucles. Comme ceci :

Sub Copier()

Dim sh As Byte
Dim i As Integer, lig As Integer

With Worksheets("JanvierFévrier")
    lig = .Range("A" & .Rows.Count).End(xlUp).Row
    If lig = 1 Then lig = 2
    .Range("A2:E" & lig).ClearContents
End With
    
For sh = 1 To Sheets.Count
    If Sheets(sh).Name <> "JanvierFévrier" Then
        With Sheets(sh)
            For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
                If UCase(.Range("E" & i)) = "OUI" Then
                    With Worksheets("JanvierFévrier")
                        lig = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                        .Range("A" & lig) = Sheets(sh).Range("A" & i)
                        .Range("D" & lig) = Sheets(sh).Range("D" & i)
                        Select Case Sheets(sh).Name
                        Case Is = "Janvier"
                            .Range("B" & lig) = Sheets(sh).Range("C" & i)
                            .Range("C" & lig) = Sheets(sh).Range("B" & i)
                        Case Is = "Février"
                            .Range("B" & lig) = Sheets(sh).Range("B" & i)
                            .Range("C" & lig) = Sheets(sh).Range("C" & i)
                        End Select
                    End With
                End If
            Next i
        End With
    End If

Next sh
End Sub

 

[fanch55]

Classeur simplifié et commenté.
Le module Zone_Ado n'est pas à modifier ou personnaliser .
Le module To_Do peut vous aider à convertir vos Tableaux statiques en Tables structurées .
Le module MonModule répond à votre demande .

Attention, le classeur doit d'abord être enregistré en bonne et due forme,
la mise à jour par Sql ne peut se faire sur un classeur en Lecture seule ...