Microsoft 365 extraction VBA avec formule si

[jeff]

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

 

[bouchard]

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

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]

les premières lignes sont incomplètes, voici la synthaxe pour espérer le faire tourner
Set ra = Sheets("A").Cells(2, 1)
Set rb = Sheets("B").Cells(2, 1)

 

[jeff]

les premières lignes sont incomplètes, voici la synthaxe pour espérer le faire tourner
Set ra = Sheets("A").Cells(2, 1)
Set rb = Sheets("B").Cells(2, 1)

merci déjà pour le code
je vous mets en pièce jointe le résultat souhaité

 

[bouchard]

Avec les corrections pour obtenir le résultat souhaité.

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]

encore merci
j'ai ce message qui s'affiche

 

[bouchard]

c'est parce que vous avez déclaré 'Option Explicit'
Toutes les variables doivent être déclarées
Je fais le choix contraire et ne déclare que les variables qui ont une portée autre que la procédure...

 

[jeff]

c'est parce que vous avez déclaré 'Option Explicit'
Toutes les variables doivent être déclarées
Je fais le choix contraire et ne déclare que les variables qui ont une portée autre que la procédure...

rien ne se passe

 

[jeff]

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

 

[bouchard]

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

 

[Phil69970]

Bonjour à tous

@jeff
En espérant que tu ne changes pas de disposition une nouvelle fois !

Je te propose ce fichier
J'ai commenté le code VBA

Merci de ton retour