copier des valeurs dasn un autre onglet si cellule et colonne identique

grotsblues

grotsblues

XLDnaute Occasionnel
Bonjour

Est-il possible de rechercher dans 2 onglets des cellules identiques et copier dans un autre onglet le résultat.

j'ai un fichier avec 4 onglets

- TOTO et TATA qui mis à jour chaque mois
- BASE qui regroupe l'ensemble des clients et qui peut évoluer
- PV qui va me permettre de comptabiliser des écritures en fonction de TOTOet TATA
Ce que je souhaiterai ( si tu trouve dans TATA et TOTO COLONNE A le chiffre 4 qui se trouve dans PV en A2 alors
copie TATA A6 dans PV A6
copie TATA D6 dans PV L6
copie TATA D2 dans PV O6
copie TATA A6 dans PV A6
copie TATA j6 dans PV L7
copie TATA j2 dans PV O7
copie TATA D2 dans PV O6…… puis passe à l onglet TOTO

J ai testé avec la fonction INDEX et EQUIV mais cela ne fonctionne pas puis avec un code VBA
qui ne donne pas ce que je souhaite
Sub Onglet_PV_maj()
Dim i As Long, o As Worksheet
With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
Sheets("PV").Application.Union(Range("a6", [a65536].End(xlUp)), Range("e6:h" & [e65536].End(xlUp).Row)).Offset(1, 0).Clear
'boucle sur les noms du classeurs
For Each o In Worksheets
If o.Name <> "PV" And o.Name <> "base" Then
'boucle i = a A
For i = 3 To o.Cells(Rows.Count, "a").End(xlUp).Row
If o.Cells(i, "a") = Sheets("PV").Range("a2") Then
Sheets("PV").Range("f65536").End(xlUp)(2).Resize(, 9).Value = o.Cells(i, "a").Resize(, 9).Value

Sheets("PV").Range("a65536").End(xlUp)(2).Value = o.Name
End If
Next
End If
Next
With Range(Range("f6"), Range("f6").End(xlDown))
.NumberFormat = "00"
.Value = Range("a2").Value
.Offset(, -1).Value = Range("e1").Value
End With
With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

Je joint un fichier comme exemple
Pouvez vous m'aider

MERCI AU FORUM
 

Pièces jointes

  • REFACT COM.xlsm
    216.3 KB · Affichages: 42
Trier par date Trier par votes
vgendron

vgendron

XLDnaute Barbatruc
Re : copier des valeurs dasn un autre onglet si cellule et colonne identique

Hello

début de code que j'ai commenté

Code: 
Sub Onglet_PV_maj()
Dim i As Long, o As Worksheet
With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    fin = [a65536].End(xlUp).Row
Sheets("PV").Application.Union(Range("a5:a" & fin), Range("e5:h" & fin), Range("L5:L" & fin)).Offset(1, 0).Clear

ValPV = Sheets("PV").Range("a2")

'boucle sur les noms du classeurs
For Each o In Worksheets
    If o.Name <> "PV" And o.Name <> "base" Then
        'boucle i = a A
        'Toto et Tata n'ont pas le meme nombre de colonnes
        Nbcol = o.Cells(1, "C").End(xlToRight).Column - 2
        'sur chaque ligne de la feuille en cours
        For i = 3 To o.Cells(Rows.Count, "a").End(xlUp).Row
            'si en colonne A, il y a la valeur PV
            If o.Cells(i, "a") = ValPV Then
            
                o.Activate 'sinon problème de copy
                'on ne copie QUE les cellules contenant une valeur
                With o.Range(Cells(i, "C"), Cells(i, Nbcol + 2))
                    .SpecialCells(xlCellTypeConstants).Copy
                End With
                
                'on retourne dans la feuille PV
                Sheets("PV").Activate
                'on se place à la dernière ligne
                With Sheets("PV").Range("L65536").End(xlUp).Offset(1, 0)
                    nb1 = .Row ' à revoir
                    'et on copie valeur transposé
                    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
                    'nombre d'élements qu'on vient de copier...
                    'à revoir
                    nb2 = Cells(nb1, "L").End(xlDown).Row
                End With
                'resize pour coller le magasin sur les lignes qu'on vient de remplir
                Sheets("PV").Range("A65536").End(xlUp).Offset(1, 0).Resize(nb2 - nb1 + 1) = o.Cells(i, "B")
            End If
        Next i
    End If
Next o
Sheets("PV").Activate
With Range(Range("f6"), Range("f6").End(xlDown))
.NumberFormat = "00"
.Value = Range("a2").Value
.Offset(, -1).Value = Range("e1").Value
End With
With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

note: l'histoire de nb1 nb2 et resize. c'est pas top..
pas plus que devoir passer d'une feuille à l'autre pour que les copy paste se passent bien. ca. c'est un truc que je maitrise toujours pas. malgré les With ... end with
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Re : copier des valeurs dasn un autre onglet si cellule et colonne identique

Re

avec quelques modifs
Code: 
Sub Onglet_PV_maj()
Dim i As Long, o As Worksheet
With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    fin = [a65536].End(xlUp).Row
Sheets("PV").Application.Union(Range("a5:a" & fin), Range("e5:h" & fin), Range("L5:L" & fin)).Offset(1, 0).Clear

ValPV = Sheets("PV").Range("a2")

'boucle sur les noms du classeurs
For Each o In Worksheets
    If o.Name <> "PV" And o.Name <> "base" Then
        'boucle i = a A
        'Toto et Tata n'ont pas le meme nombre de colonnes
        Nbcol = o.Cells(1, "C").End(xlToRight).Column - 2
        'sur chaque ligne de la feuille en cours
        For i = 3 To o.Cells(Rows.Count, "a").End(xlUp).Row
            'si en colonne A, il y a la valeur PV
            If o.Cells(i, "A") = ValPV Then
                
                o.Activate 'sinon problème de copy
                'on ne copie QUE les cellules contenant une valeur
                o.Range(Cells(i, "C"), Cells(i, Nbcol + 2)).SpecialCells(xlCellTypeConstants).Copy
                
                'on retourne dans la feuille PV
                Sheets("PV").Activate
                'on se place à la dernière ligne
                nb1 = Sheets("PV").Range("L65536").End(xlUp).Offset(1, 0).Row
                With Sheets("PV").Range("L65536").End(xlUp).Offset(1, 0)
                    'nb1 = .Row ' à revoir
                    'et on copie valeur transposé
                    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
                    'nombre d'élements qu'on vient de copier...
                    'à revoir
                    nb2 = Range("L65536").End(xlUp).Row
                End With
                'resize pour coller le magasin sur les lignes qu'on vient de remplir
                Sheets("PV").Range("A65536").End(xlUp).Offset(1, 0).Resize(nb2 - nb1 + 1) = o.Cells(i, "B")
            End If
        Next i
    End If
Next o
Sheets("PV").Activate
With Range(Range("f6"), Range("f6").End(xlDown))
    .NumberFormat = "00"
    .Value = Range("a2").Value
    .Offset(, -1).Value = Range("e1").Value
End With
With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub


je ne suis pas allé voir ta macro évènementielle dans le thisworkbook qui remplit les colonnes E et F jusqu'en bas
 
Vote positif 0 Vote négatif
grotsblues

grotsblues

XLDnaute Occasionnel
Re : copier des valeurs dasn un autre onglet si cellule et colonne identique

Merci pour ta réponse rapide, le code fonctionne bien et en plus tes commentaires m'aide à comprendre
sauf qu'il me manque dans onglet PV colonne O les DEPTID
c'est-à-dire pour les 100.00 il faudrait qu'elle recopie (01010) pour les 150.00 (01020) etc…….
le problème est que dans TATA et TOTO la ligne 2 toutes les cellules sont remplies
et je ne comprend pas pourquoi elle recopie dans onglet PV colonne E et F la date et le mois jusqu'à 655…..
il faudrait que recopie que si la colonne A est non vide

MERCI de ton aide
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Re : copier des valeurs dasn un autre onglet si cellule et colonne identique

Hello

Première modif
recopie la formule colonne B et C
remplit les colonnes E et F (ton problème venait du end(xldown) que j'ai enlevé: j'utilise nb2 puisqu'on l'a..
et pour le DPTID. j'y travaille.. mais ca risque d'etre difficile.. à moins qu'un resize fasse l'affaire?? je ne sais pas trop encore

Code: 
Sub Onglet_PV_maj()
Dim i As Long, o As Worksheet
With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    fin = [a65536].End(xlUp).Row
Sheets("PV").Application.Union(Range("a5:a" & fin), Range("e5:h" & fin), Range("L5:L" & fin)).Offset(1, 0).Clear

ValPV = Sheets("PV").Range("a2")

'boucle sur les noms du classeurs
For Each o In Worksheets
    If o.Name <> "PV" And o.Name <> "base" Then
        'boucle i = a A
        'Toto et Tata n'ont pas le meme nombre de colonnes
        Nbcol = o.Cells(1, "C").End(xlToRight).Column - 2
        'sur chaque ligne de la feuille en cours
        For i = 3 To o.Cells(Rows.Count, "a").End(xlUp).Row
            'si en colonne A, il y a la valeur PV
            If o.Cells(i, "A") = ValPV Then
                
                o.Activate 'sinon problème de copy
                'on ne copie QUE les cellules contenant une valeur
                o.Range(Cells(i, "C"), Cells(i, Nbcol + 2)).SpecialCells(xlCellTypeConstants).Copy
                
                'on retourne dans la feuille PV
                Sheets("PV").Activate
                'on se place à la dernière ligne
                nb1 = Sheets("PV").Range("L65536").End(xlUp).Offset(1, 0).Row
                With Sheets("PV").Range("L65536").End(xlUp).Offset(1, 0)
                    'nb1 = .Row ' à revoir
                    'et on copie valeur transposé
                    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
                    'nombre d'élements qu'on vient de copier...
                    'à revoir
                    nb2 = Range("L65536").End(xlUp).Row
                End With
                'resize pour coller le magasin sur les lignes qu'on vient de remplir
                Sheets("PV").Range("A65536").End(xlUp).Offset(1, 0).Resize(nb2 - nb1 + 1) = o.Cells(i, "B")
                If nb1 <> 6 Then nb1 = nb1 - 1
                Sheets("PV").Range("B" & nb1 & ":C" & nb2).FillDown '(Range("B" & nb1 & ":C" & nb2)) 'Resize (nb2 - nb1 + 1)
            End If
        Next i
    End If
Next o
Sheets("PV").Activate
With Range("f6:f" & nb2)
    .NumberFormat = "00"
    .Value = Range("a2").Value
    .Offset(, -1).Value = Range("e1").Value
End With
With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Re : copier des valeurs dasn un autre onglet si cellule et colonne identique

Re
Avec Bricolage..

Code: 
Sub Onglet_PV_maj()
Dim i As Long, o As Worksheet
With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    fin = [a65536].End(xlUp).Row
Sheets("PV").Application.Union(Range("a5:a" & fin), Range("e5:h" & fin), Range("L5:L" & fin)).Offset(1, 0).Clear

ValPV = Sheets("PV").Range("a2")

'boucle sur les noms du classeurs
For Each o In Worksheets
    If o.Name <> "PV" And o.Name <> "base" Then
        'boucle i = a A
        'Toto et Tata n'ont pas le meme nombre de colonnes
        Nbcol = o.Cells(1, "C").End(xlToRight).Column - 2
        'sur chaque ligne de la feuille en cours
        For i = 3 To o.Cells(Rows.Count, "a").End(xlUp).Row
            'si en colonne A, il y a la valeur PV
            If o.Cells(i, "A") = ValPV Then
                
                o.Activate 'sinon problème de copy
                'on ne copie QUE les cellules contenant une valeur
                Set ToFact = o.Range(Cells(i, "C"), Cells(i, Nbcol + 2)).SpecialCells(xlCellTypeConstants) '.Select
                'Set ToFact = Selection
                Set DeptId = ToFact.Offset(-i + 2, 0)
                ToFact.Copy

                'on retourne dans la feuille PV
                Sheets("PV").Activate
                'on se place à la dernière ligne
                nb1 = Sheets("PV").Range("L65536").End(xlUp).Offset(1, 0).Row
                With Sheets("PV").Range("L65536").End(xlUp).Offset(1, 0)
                    'nb1 = .Row ' à revoir
                    'et on copie valeur transposé
                    .PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=True
                    'nombre d'élements qu'on vient de copier...
                    'à revoir
                    nb2 = Range("L65536").End(xlUp).Row
                    o.Activate
                    DeptId.Copy
                    .Offset(0, 3).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=True
                End With
                'resize pour coller le magasin sur les lignes qu'on vient de remplir
                Sheets("PV").Range("A65536").End(xlUp).Offset(1, 0).Resize(nb2 - nb1 + 1) = o.Cells(i, "B")
                If nb1 <> 6 Then nb1 = nb1 - 1
                Sheets("PV").Range("B" & nb1 & ":C" & nb2).FillDown '(Range("B" & nb1 & ":C" & nb2)) 'Resize (nb2 - nb1 + 1)
            End If
        Next i
    End If
Next o
Sheets("PV").Activate
With Range("f6:f" & nb2)
    .NumberFormat = "00"
    .Value = Range("a2").Value
    .Offset(, -1).Value = Range("e1").Value
End With
With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Re : copier des valeurs dasn un autre onglet si cellule et colonne identique

nouvelle modif pour tout effacer au début et donc remettre les formules

Code: 
Sub Onglet_PV_maj()
Dim i As Long, o As Worksheet

formuleB = "=SI(A6<>"""";RECHERCHEV(A6;base!$A:$C;3;FAUX);"""")"
formuleC = "=SI(A6<>"""";RECHERCHEV(A6;base!$A:$E;5;FAUX);"""")"
formuleP = "=SI(A6<>"""";RECHERCHEV(A6;base!$A:$E;4;FAUX);"""")"

With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    fin = [a65536].End(xlUp).Row
Sheets("PV").Application.Union(Range("a6:f" & fin), Range("L6:P" & fin)).ClearContents

ValPV = Sheets("PV").Range("a2")

'boucle sur les noms du classeurs
For Each o In Worksheets
    If o.Name <> "PV" And o.Name <> "base" Then
        'boucle i = a A
        'Toto et Tata n'ont pas le meme nombre de colonnes
        Nbcol = o.Cells(1, "C").End(xlToRight).Column - 2
        'sur chaque ligne de la feuille en cours
        For i = 3 To o.Cells(Rows.Count, "a").End(xlUp).Row
            'si en colonne A, il y a la valeur PV
            If o.Cells(i, "A") = ValPV Then
                
                o.Activate 'sinon problème de copy
                'on ne copie QUE les cellules contenant une valeur
                Set ToFact = o.Range(Cells(i, "C"), Cells(i, Nbcol + 2)).SpecialCells(xlCellTypeConstants) '.Select
                'Set ToFact = Selection
                Set DeptId = ToFact.Offset(-i + 2, 0)
                ToFact.Copy

                'on retourne dans la feuille PV
                Sheets("PV").Activate
                'on se place à la dernière ligne
                nb1 = Sheets("PV").Range("L65536").End(xlUp).Offset(1, 0).Row
                With Sheets("PV").Range("L65536").End(xlUp).Offset(1, 0)
                    'nb1 = .Row ' à revoir
                    'et on copie valeur transposé
                    .PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=True
                    'nombre d'élements qu'on vient de copier...
                    'à revoir
                    nb2 = Range("L65536").End(xlUp).Row
                    o.Activate
                    DeptId.Copy
                    .Offset(0, 3).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=True
                End With
                'resize pour coller le magasin sur les lignes qu'on vient de remplir
                Sheets("PV").Range("A65536").End(xlUp).Offset(1, 0).Resize(nb2 - nb1 + 1) = o.Cells(i, "B")
                If nb1 <> 6 Then nb1 = nb1 - 1
                Sheets("PV").Range("B" & nb1 & ":C" & nb2).FillDown '(Range("B" & nb1 & ":C" & nb2)) 'Resize (nb2 - nb1 + 1)
            End If
        Next i
    End If
Next o
Sheets("PV").Activate
Range("B6").FormulaLocal = formuleB
Range("C6").FormulaLocal = formuleC
Range("P6").FormulaLocal = formuleP
Range("B6:C" & nb2).FillDown
Range("P6:P" & nb2).FillDown

With Range("f6:f" & nb2)
    .NumberFormat = "00"
    .Value = Range("a2").Value
    .Offset(, -1).Value = Range("e1").Value
End With
With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
Re : copier des valeurs dasn un autre onglet si cellule et colonne identique

Voici.. ca tient en une ligne

Autre chose ? :)

Code: 
Sub Onglet_PV_maj()
Dim i As Long, o As Worksheet

formuleB = "=SI(A6<>"""";RECHERCHEV(A6;base!$A:$C;3;FAUX);"""")"
formuleC = "=SI(A6<>"""";RECHERCHEV(A6;base!$A:$E;5;FAUX);"""")"
formuleP = "=SI(A6<>"""";RECHERCHEV(A6;base!$A:$E;4;FAUX);"""")"

With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    fin = [a65536].End(xlUp).Row
Sheets("PV").Application.Union(Range("a6:f" & fin), Range("L6:P" & fin)).ClearContents

ValPV = Sheets("PV").Range("a2")

'boucle sur les noms du classeurs
For Each o In Worksheets
    If o.Name <> "PV" And o.Name <> "base" Then
        'boucle i = a A
        'Toto et Tata n'ont pas le meme nombre de colonnes
        Nbcol = o.Cells(1, "C").End(xlToRight).Column - 2
        'sur chaque ligne de la feuille en cours
        For i = 3 To o.Cells(Rows.Count, "a").End(xlUp).Row
            'si en colonne A, il y a la valeur PV
            If o.Cells(i, "A") = ValPV Then
                
                o.Activate 'sinon problème de copy
                'on ne copie QUE les cellules contenant une valeur
                Set ToFact = o.Range(Cells(i, "C"), Cells(i, Nbcol + 2)).SpecialCells(xlCellTypeConstants) '.Select
                'Set ToFact = Selection
                Set DeptId = ToFact.Offset(-i + 2, 0)
                ToFact.Copy

                'on retourne dans la feuille PV
                Sheets("PV").Activate
                'on se place à la dernière ligne
                nb1 = Sheets("PV").Range("L65536").End(xlUp).Offset(1, 0).Row
                With Sheets("PV").Range("L65536").End(xlUp).Offset(1, 0)
                    'nb1 = .Row ' à revoir
                    'et on copie valeur transposé
                    .PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=True
                    'nombre d'élements qu'on vient de copier...
                    'à revoir
                    nb2 = Range("L65536").End(xlUp).Row
                    'recopie du nom de l'onglet source
                    Range("G" & nb1).Resize(nb2 - nb1 + 1) = o.Name
                    o.Activate
                    DeptId.Copy
                    .Offset(0, 3).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=True
                End With
                'resize pour coller le magasin sur les lignes qu'on vient de remplir
                Sheets("PV").Range("A65536").End(xlUp).Offset(1, 0).Resize(nb2 - nb1 + 1) = o.Cells(i, "B")
                If nb1 <> 6 Then nb1 = nb1 - 1
                Sheets("PV").Range("B" & nb1 & ":C" & nb2).FillDown '(Range("B" & nb1 & ":C" & nb2)) 'Resize (nb2 - nb1 + 1)
            End If
        Next i
    End If
Next o
Sheets("PV").Activate
Range("B6").FormulaLocal = formuleB
Range("C6").FormulaLocal = formuleC
Range("P6").FormulaLocal = formuleP
Range("B6:C" & nb2).FillDown
Range("P6:P" & nb2).FillDown

With Range("f6:f" & nb2)
    .NumberFormat = "00"
    .Value = Range("a2").Value
    .Offset(, -1).Value = Range("e1").Value
End With
With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
253
Phil69970
Phil69970
Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
357
Chaton77
Chaton77
N
  • Résolu(e)
XL 2021 comment faire recherche dans une colonne et ligne
Réponses
5
Affichages
310
job75
job75
P
  • Question
XL 2019 Copier des cellules d'une feuille sur une autre
Réponses
2
Affichages
534
phoceenjo
P
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
2 K
thivame
T
Jojo973
  • Question
Microsoft 365 Trier des données et les afficher sur une autre feuille
Réponses
10
Affichages
340
Jojo973
Jojo973
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
1 K
Dranreb
Dranreb
V
  • Résolu(e)
XL 2016 Facturier : Retour à la ligne sur la facture
2
Réponses
19
Affichages
953
Vermithor
V
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
901
Nicolas JACQUIN
Nicolas JACQUIN
C
  • Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
317
CathyLD
C

Membres actuellement en ligne

13 membres et 116 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 666
Messages
2 111 692
Membres
111 260
dernier inscrit
Arnaud1606