Transfert et suppression de données

Bonjour à tous,

Je dois transférer les données des colonnes "T" et "U" du tableau "S:X" seulement si le nom du joueurs apparaît dans l'un des tableaux "A:F", "G:L" ou "M:R". J'ai surligné les noms de trois joueurs qui apparaissent dans le tableau "S:X" ainsi que dans l'un des autres tableaux.

J'aimerais pouvoir éliminer les données vis-à-vis du nom surligné dans les colonnes "T" et "U" du tableau "S:X" et les additionner aux nombre vis-à-vis le nom correspondant, dans les colonnes correspondantes des autres tableaux, soit avec un code VBA ou une formule.

SVP, si c'est un code VBA, je dois m'assurer que le code s'ajoutera, sans problème, soit à la suite de mon code déjà existant, ou en utilisant la fonction "Call".

Merci beaucoup pour votre aide.

3classeur1v1.xlsm (153.67 Ko)

Salut,

J'ai voulu tenter un code, mais je ne comprends pas toutes tes explications.

Tu dis que les 3 joueurs surlignés dans la plage S:X sont les seuls qui se trouvent dans les autres tableaux, alors que je trouve chacun d'eux dans l'une des autres plages. Par exemple Marcel Legault en A129.

Puis tes deux joueurs surlignés dans la plage M:R se trouvent déjà dans la plage A:G. Comment savoir dans quelle plage leur ajouter leurs valeurs ?

Et comment savoir si mon code peut être ajouté au tien si tu ne le fournis pas ?

A te relire.

3classeur1-v2.xlsm (303.19 Ko)

Bonjour Yvouille,

Désolé. Mon erreur. J'aurais du spécifier que la macro ne doit pas prendre en compte les lignes 51 en descendant. Seule les lignes 1 à 50 doivent être incluses dans la macro. Par ce fait, il n'y a plus de doublon dans aucune des plages de "A50:Q50".

J'ai surligné les trois noms à titre d'exemple. C'est possible qu'il y en ait d'autres.

Voir la macro ci-dessous. Comme tu peux voir, elle est très rudimentaire. Mon expertise en code VBA est limitée.

Merci et bonne journée.

6classeur1-v2.xlsm (303.19 Ko)

Sub Trier()

'

' Trier Macro

Application.ScreenUpdating = False

Sheets("Impôts").Select

Range("AI1:AT1002").Select

Selection.Copy

Sheets("Trier").Select

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues

Range("N1:N2003").Select

Selection.Copy

Range("R1").Select

Selection.PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

Columns("R:R").Select

ActiveSheet.Range("$R$1:$R$2003").RemoveDuplicates Columns:=1, Header:= _

xlYes

Sheets("Trier").Select

Range("AB1:AB1003").Select

Selection.Copy

Range("AF1").Select

Selection.PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

Columns("AF:AF").Select

ActiveSheet.Range("$AF$1:$AF$1003").RemoveDuplicates Columns:=1, Header:= _

xlYes

Columns("R:W").Select

Selection.Copy

Sheets("Imprimer").Select

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues

Range("A1:F2003").Select

ActiveWorkbook.Worksheets("Imprimer").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("Imprimer").Sort.SortFields.Add Key:=Range( _

"E2:E2003"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _

xlSortNormal

With ActiveWorkbook.Worksheets("Imprimer").Sort

.SetRange Range("A1:F2003")

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

Range("A51:F99").Select

Selection.Copy

Range("G2").Select

ActiveSheet.Paste

Range("A100:F148").Select

Selection.Copy

Range("M2").Select

ActiveSheet.Paste

Application.CutCopyMode = False

Sheets("Trier").Select

Columns("AF:AK").Select

Selection.Copy

Sheets("Imprimer").Select

Range("S1").Select

Selection.PasteSpecial Paste:=xlPasteValues

Range("S1:X1003").Select

ActiveWorkbook.Worksheets("Imprimer").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("Imprimer").Sort.SortFields.Add Key:=Range( _

"W2:W1003"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _

xlSortNormal

With ActiveWorkbook.Worksheets("Imprimer").Sort

.SetRange Range("S1:X1003")

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

Range("A1:R50").Select

Selection.PrintOut Copies:=1

Range("S1:X50").Select

Selection.PrintOut Copies:=1

Range("A1").Select

End Sub

Salut,

Je pense que ma macro est plus facile à adapter que la tienne

Option Explicit

Sub Transfert()
Dim i As Integer, j As Integer, k As Byte
Application.ScreenUpdating = False
For i = 2 To Range("S" & Rows.Count).End(xlUp).Row
    For k = 1 To 13 Step 6
        On Error Resume Next
        j = Application.WorksheetFunction.Match(Range("S" & i), Range(Cells(1, k), Cells(50, k)), 0)
        If j > 0 Then
            Cells(j, k + 1) = Cells(j, k + 1) + Range("T" & i)
            Cells(j, k + 2) = Cells(j, k + 2) + Range("U" & i)
            Range("T" & i) = ""
            Range("U" & i) = ""
            GoTo Etiquette
        End If
        j = 0
    Next k
Etiquette:
j = 0
Next i
End Sub

Dans le fichier ci-joint, les résultats sont reportés comme tu le souhaites dans les 50 premières lignes. Si une personne a un résultat en S:V mais qu'elle n'est pas présente en A:R, il ne se passe rien.

J'ai placé un bouton en S1 pour déclencher le code.

Cordialement.

3classeur1-v3.xlsm (313.03 Ko)

Bonsoir Yvouille,

Incroyable. Tu as résolu mon problème que je croyais insoluble. C'est formidable.

J'ai inclut ton code dans ma macro avec la fonction "Call" juste avant l'impression des données, ce qui fait que la transfert d'une plage à l'autre s'exécute avant l'impression. Les feuilles imprimées donne exactement le résultat attendu.

Merci beaucoup pour ton aide.

Je ferme le dossier.

Rechercher des sujets similaires à "transfert suppression donnees"