Problema de macro de excel

A Continuación os detallo una macro que me han hecho para un programa, el problema que tiene es que los resultados los vuelve a repetir y acumular,cada vez que le doy a soluccionar macro, lo que necesitaria es que lispiase la tabla de resultados y volviera a poner los nuevos.
Esta es la formulación que se ha hecho, en caso de necesitar mas información para si podeis hecharme una mano y soluccionar el problema, enviarme un e-mail y os podre enviar la hoja de excel. Saludos y Gracias
Option Explicit
Sub Llena_valores()
 On Error GoTo EH
  Dim NHoja As String
  Dim Val As Variant
  Dim i, j, l, k, Ur, Uc As Integer
  Workbooks("Tabla Sin Fondos.xls").Activate
  ActiveWorkbook.Sheets("PRINCIPAL").Activate
  Ur = ActiveSheet.Cells(5, 6).Value
  Uc = ActiveSheet.Cells(6, 6).Value
  i = 1
  Do Until i = 5
   ActiveWorkbook.Sheets("PRINCIPAL").Activate
   Select Case i
    Case 1
     NHoja = ActiveSheet.Cells(3, 16).Value
    Case 2
     NHoja = ActiveSheet.Cells(3, 20).Value
    Case 3
     NHoja = ActiveSheet.Cells(3, 24).Value
    Case 4
     NHoja = ActiveSheet.Cells(3, 28).Value
   End Select
   ActiveWorkbook.Sheets(NHoja).Activate
   j = 7
   While j <= Uc
    l = 8
    While l <= Ur
     If ActiveSheet.Cells(l, j).Value <> "" And _
        ActiveSheet.Cells(l, j).Value <> "Combinaciones válidas formadas por dos números entre 1 y 3 veces cada uno" And _
        ActiveSheet.Cells(l, j).Value <> "Combinaciones válidas formadas por un solo número entre 1 y 6 veces" _
        Then
      Val = ActiveSheet.Cells(l, j).Value
      If Not IsEmpty(Val) Then
       ActiveWorkbook.Sheets("PRINCIPAL").Activate
       Select Case i
        Case 1
         k = 16
        Case 2
         k = 20
        Case 3
         k = 24
        Case 4
         k = 28
       End Select
       ActiveSheet.Cells(3, k).Activate
       While ActiveCell.Value <> ""
        ActiveSheet.Cells(ActiveCell.Row + 1, k).Activate
       Wend 'While ActiveCell.Value = " "
       ActiveCell.Value = Val
       ActiveWorkbook.Sheets(NHoja).Activate
      End If 'If Not IsEmpty(Val) Then
     End If 'If ActiveSheet.Cells(6, 5).Value <> "" Then
     l = l + 1
    Wend 'While l >= Ur
    j = j + 1
   Wend 'While j >= Uc
   i = i + 1
  Loop 'Do Until i = 3
  ActiveWorkbook.Sheets("PRINCIPAL").Activate
  Exit Sub
EH:
 Select Case Err.Number
  Case 1004:
   Resume Next
  Case Else:
   MsgBox Err.Number & "-" & Err.Description
 End Select
End Sub