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.
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.
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.
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.
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.