Microsoft 365 extraction VBA avec formule si

jeff

XLDnaute Nouveau
bonjour
je voudrais extraire des données de deux onglets vers un onglet du même classeur avec une condition situer dans une cellule de deux onglets des données
je vous joint le fichier
dans l'onglet A
je souhaiterais extraire les données qui ce situe dans les colonnes B D E G H I J avec la condition que je trouve dans la colonne AK
dans l'onglet B
je souhaiterais extraire les données qui ce situe dans les colonnes A B C D E F G avec la condition que je trouve dans la colonne AI
et concaténer le tout dans l'onglet x
en sachant que je vais rajouter régulièrement des données dans les onglets A et B
merci d'avance de votre aide
 

Pièces jointes

  • classeur.xlsx
    79.1 KB · Affichages: 11

bouchard

XLDnaute Nouveau
Bonjour Jeff,
c'est pas très clair ton histoire.
je te propose quand même un code .
le code tient compte des colonnes fusionnées et je ne connais pas les conditions.
il manquera quand même un flag qui dira si la lignes est déjà copiée ou non pour les relances.

*j'ai pas testé, j'ai pas de données

Bon code
VB:
Sub Concat()
Set ra = Sheets("A")
Set rb = Sheets("B")
Set wx = Sheets("X").Cells(100000, 13).End(xlUp).Offset(1, 0)
Do While ra <> ""
    If ra.Offset(0, 36) = "x1" Then
        wx.Offset(0, 0) = ra.Offset(0, 1)
        wx.Offset(0, 1) = ra.Offset(0, 2)
        wx.Offset(0, -6) = ra.Offset(0, 4)
        wx.Offset(0, -5) = ra.Offset(0, 5)
        wx.Offset(0, -3) = ra.Offset(0, 7)
        wx.Offset(0, -2) = ra.Offset(0, 8)
        wx.Offset(0, -1) = ra.Offset(0, 9)
        Set wx = wx.Offset(1, 0)
    End If
    Set ra = ra.Offset(1, 0)
Loop
Do While rb <> ""
    If rb.Offset(0, 36) = "x1" Then
        wx.Offset(0, 0) = rb.Offset(0, 0)
        wx.Offset(0, 1) = rb.Offset(0, 1)
        wx.Offset(0, -6) = rb.Offset(0, 2)
        wx.Offset(0, -5) = rb.Offset(0, 3)
        wx.Offset(0, -3) = rb.Offset(0, 4)
        wx.Offset(0, -2) = rb.Offset(0, 5)
        wx.Offset(0, -1) = rb.Offset(0, 6)
        Set wx = wx.Offset(1, 0)
    End If
    Set rb = rb.Offset(1, 0)
Loop
End Sub
 

bouchard

XLDnaute Nouveau
Avec les corrections pour obtenir le résultat souhaité.
VB:
Sub Concat()
Set ww = Workbooks("classeur(1).xlsx")
Set ra = ww.Sheets("A").Cells(2, 1)
Set rb = ww.Sheets("B").Cells(2, 1)
Set wx = ww.Sheets("X").Cells(100000, 13).End(xlUp).Offset(1, 0)
Do While ra & ra.Offset(0, 1) <> ""
    If Left(ra.Offset(0, 36), 1) = "x" Then
        wx.Offset(0, 0) = ra.Offset(0, 1)
        wx.Offset(0, 1) = ra.Offset(0, 2)
        wx.Offset(0, 2) = ra.Offset(0, 3)
        wx.Offset(0, -6) = ra.Offset(0, 4)
        wx.Offset(0, -5) = ra.Offset(0, 5)
        wx.Offset(0, -4) = ra.Offset(0, 6)
        wx.Offset(0, -3) = ra.Offset(0, 7)
        wx.Offset(0, -2) = ra.Offset(0, 8)
        wx.Offset(0, -1) = ra.Offset(0, 9)
        Set wx = wx.Offset(1, 0)
    End If
    Set ra = ra.Offset(1, 0)
Loop
Do While rb <> ""
    If Left(rb.Offset(0, 34), 1) = "x" Then
        wx.Offset(0, 0) = rb.Offset(0, 0)
        wx.Offset(0, 1) = "L"
        wx.Offset(0, 2) = rb.Offset(0, 1)
        wx.Offset(0, -6) = rb.Offset(0, 2)
        wx.Offset(0, -5) = "L"
        wx.Offset(0, -4) = rb.Offset(0, 3)
        wx.Offset(0, -3) = rb.Offset(0, 4)
        wx.Offset(0, -2) = rb.Offset(0, 5)
        wx.Offset(0, -1) = rb.Offset(0, 6)
        Set wx = wx.Offset(1, 0)
    End If
    Set rb = rb.Offset(1, 0)
Loop
End Sub

Bon code
 

jeff

XLDnaute Nouveau
encore merci
j'ai ce message qui s'affiche

1704466124616.png
 

jeff

XLDnaute Nouveau
VB:
Sub Concat()
    ' Déclaration des constantes
    Const RA As String = "A"
    Const RB As String = "B"
    Const WX As String = "X"
    Const COLONNE_CONDITION As Long = 37
    Const VALEUR_CONDITION As String = "C²"
    
    ' Déclaration des variables
    Dim plageA As Range
    Dim plageB As Range
    Dim plageX As Range
    Dim cellule As Range
    Dim nbA As Long
    Dim nbB As Long
    Dim i As Long
    
    ' Initialisation des variables
    Set plageA = Sheets(RA).Range("b2:j2")
    Set plageB = Sheets(RB).Range("A2:k2")
    Set plageX = Sheets(WX).Range("G3:O3")
    
    ' Compte le nombre de cellules qui répondent à la condition dans chaque plage
    nbA = WorksheetFunction.CountIf(plageA.Columns(COLONNE_CONDITION), VALEUR_CONDITION)
    nbB = WorksheetFunction.CountIf(plageB.Columns(COLONNE_CONDITION), VALEUR_CONDITION)
    
    ' Redimensionne le tableau de résultats
    Set plageX = plageX.Resize(nbA + nbB, 9)
    
    ' Parcours de la plage A
    i = 1
    Set cellule = plageA.Columns(COLONNE_CONDITION).Find(VALEUR_CONDITION)
    If Not cellule Is Nothing Then
        Do
            ' Copie les valeurs des cellules qui répondent à la condition vers la feuille de calcul X
            plageA.Rows(cellule.Row).Copy plageX.Rows(i)
            i = i + 1
            Set cellule = plageA.Columns(COLONNE_CONDITION).FindNext(cellule)
        Loop While Not cellule Is Nothing And cellule.Row > plageA.Rows(1).Row
    End If
    
    ' Parcours de la plage B
    Set cellule = plageB.Columns(COLONNE_CONDITION).Find(VALEUR_CONDITION)
    If Not cellule Is Nothing Then
        Do
            ' Copie les valeurs des cellules qui répondent à la condition vers la feuille de calcul X
            plageB.Rows(cellule.Row).Copy plageX.Rows(i)
            i = i + 1
            Set cellule = plageB.Columns(COLONNE_CONDITION).FindNext(cellule)
        Loop While Not cellule Is Nothing And cellule.Row > plageB.Rows(1).Row
    End If
End Sub

j'ai créer ce code
mais il tourne en boucle
je vous joint le fichier
 

Pièces jointes

  • classeur.xlsm
    147.1 KB · Affichages: 5

bouchard

XLDnaute Nouveau
pourquoi faire simple alors qu'il était possible de faire compliqué!
je ne comprends pas votre démarche, le code présenté ne répond pas vraiment à votre demande de départ.
l'ordre des colonnes résultat diffère,
la condition est différente
la position de colonne de condition était différente entre A et B
...
Vous utilisez un compteur de ligne alors que vous utilisez 'find' et 'findnext'? c'est l'un ou l'autre.
Quand on utilise findnext on s'arrête quand l'adresse de cellule redevient identique au premier Find.

bon code
 

Statistiques des forums

Discussions
313 271
Messages
2 096 724
Membres
106 720
dernier inscrit
Alain EDZOA