Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 extraction VBA avec formule si

J

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
Trier par date Trier par votes
B

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
 
Vote positif 0 Vote négatif
B

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
 
Vote positif 0 Vote négatif
B

bouchard

XLDnaute Nouveau
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...
 
Vote positif 0 Vote négatif
J

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
Vote positif 0 Vote négatif
B

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
 
Vote positif 0 Vote négatif

Phil69970

XLDnaute Barbatruc
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
 

Pièces jointes

  • Copie 2 feuilles filtrees sur la 3eme V2.xlsm
    158.3 KB · Affichages: 6
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Résolu(e)
XL 2019 Extraction de données dans une autre plage !
Réponses
6
Affichages
127
Caninge
  • Résolu(e)
Microsoft 365 Extraction d'informations sur différents onglets en partant d'une base de données
Réponses
7
Affichages
515
MBax
  • Résolu(e)
Power Query extraction de caracteres
Réponses
5
Affichages
497
JFL_XLD
J
  • Question
XL 2019 Extraction de Données dans fichier PDF
Réponses
14
Affichages
492
Caninge
  • Résolu(e)
XL 2010 soustraction ou addition date et heure
Réponses
2
Affichages
141
jeanmi
T
  • Question
Microsoft 365 Besoin d'aide pour transférer des cellules sous plusieurs conditions
Réponses
5
Affichages
462
fanfan38
R
  • Résolu(e)
XL 2019 Comment extraire séparément plusieures chaines de caractères ou chiffres/nombres depuis une cellule avec libellé complexe alpha numérique
2
Réponses
28
Affichages
1 K
Renardy
R
  • Question
XL 2021 VBA: Extraction des paramètres d'une formule (texte)
2
Réponses
28
Affichages
706
p'tit vieux
R
  • Question
Microsoft 365 Tableau de progressions
Réponses
10
Affichages
263
Rosario.
R
B
  • Résolu(e)
Microsoft 365 extraction de données vba
2 3 4
Réponses
45
Affichages
2 K
chris
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…