Fixer une plage (A:B) automatiquement à l'exécution d'une macro (module2)

Bonjour,

J'ai besoin de votre aide pour fixer une plage pour exécuter une macro "Module 2".

En effet la macro est définie de telle sorte que je dois choisir manuellement mon tableau avant d'exécuter la macro.

Mes données se trouveront toujours à la colonne "A:B".

Le seul souci, je ne connais pas la taille en avance.

Je voudrai sélectionner le maximum de lignes voir même toutes les colonnes "A" et "B" pour les deux feuilles "Feuil1_bis" et "Feuil2_bis".

Je joins un fichier:

Ci-dessous mon code :

Sub CombineRows()
'Updateby Extendoffice
Dim WorkRng As Range
Dim Dic As Variant
Dim arr As Variant

On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Set Dic = CreateObject("Scripting.Dictionary")
arr = WorkRng.Value
For i = 1 To UBound(arr, 1)
Dic(arr(i, 1)) = Dic(arr(i, 1)) + arr(i, 2)
Next
Application.ScreenUpdating = False
WorkRng.ClearContents
WorkRng.Range("A1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.keys)
WorkRng.Range("B1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.items)
Application.ScreenUpdating = True
End Sub

Bonjour monnom

Essaie cela

Sub CombineRows()
'Updateby Extendoffice
Dim WorkRng As Range
Dim Dic As Variant
Dim arr As Variant
Dim Dlig As Integer
On Error Resume Next
Dlig = Range("A65536").End(xlUp).Row
Range("A" & Dlig & ":B" & Dlig).Select
    xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Set Dic = CreateObject("Scripting.Dictionary")
    arr = WorkRng.Value
For i = 1 To UBound(arr, 1)
    Dic(arr(i, 1)) = Dic(arr(i, 1)) + arr(i, 2)
Next
    Application.ScreenUpdating = False
    WorkRng.ClearContents
    WorkRng.Range("A1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.keys)
    WorkRng.Range("B1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.items)
    Application.ScreenUpdating = True
End Sub

Bon courage