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

grotsblues · 14 Juin 2016

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

vgendron · 14 Juin 2016

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

vgendron · 14 Juin 2016

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

grotsblues · 15 Juin 2016

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

vgendron · 15 Juin 2016

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

vgendron · 15 Juin 2016

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

grotsblues · 15 Juin 2016

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

ton bricolage marche super bien merci pour tous
à bientôt

vgendron · 15 Juin 2016

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

grotsblues · 15 Juin 2016

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

je teste et te tiens au courant

merci

grotsblues · 15 Juin 2016

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

Par contre, est il possible d'ecrire dans onglet PV colonne G le nom de l'onglet recopier.

vgendron · 15 Juin 2016

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

grotsblues · 16 Juin 2016

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

Bonjour et merci pour ta patience
et en plus je ne savais pas qu'on pouvait insérer des formules dans le code. Tout fonctionne à merveille

A bientôt

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

grotsblues

XLDnaute Occasionnel

Pièces jointes

vgendron

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

grotsblues

XLDnaute Occasionnel

vgendron

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

grotsblues

XLDnaute Occasionnel

vgendron

XLDnaute Barbatruc

grotsblues

XLDnaute Occasionnel

grotsblues

XLDnaute Occasionnel

vgendron

XLDnaute Barbatruc

grotsblues

XLDnaute Occasionnel

Discussions similaires