Erreur Depassement de capacité

Sub selectionTab()
Dim firstCell, lastCell, Zone As Range
Dim TestPair As Integer
TestPair = ActiveSheet.Index
If TestPair < 4 Or TestPair Mod 2 = 0 Or TestPair = Worksheets.Count Then
MsgBox "Sélectionnez une autre feuille pour l'exportation, celle ci n'est pas valide !!!"
Exit Sub
End If
Application.ScreenUpdating = False
'---- selection de la plage de donnée
'---- en ne selectionnant pas les cellules ne comportant que des formules
Set firstCell = Range("AC5")
Set lastCell = Range("W65536").End(xlUp)
Set Zone = Range(firstCell, lastCell)
For i = Zone.Count To 1 Step -1
If Zone.Cells(i) <> "" Then Exit For
Next
Set lastCell = Zone.Parent.Cells(Zone.Cells(i).Row, 23) ' 19 =Colonne S
Range(firstCell, lastCell).Copy
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 2
Range("B1").Select
Workbooks.Add
 
Range("B1").PasteSpecial Paste:=xlPasteValues
 
'----Permet d'effacer les ligne comportant un zero en quantité
'----et de creer une liste alphabetique dans la premiere colonne
Dim rADet As Range
Dim rTab As Range
Dim bColA As Integer 'Caractére 1° ligne
Dim r As Range
Set firstCell = Range("A1")
Set lastCell = Range("H65536").End(xlUp)
Set rTab = Range(firstCell, lastCell)
Stop
bColA = 1
For Each r In rTab.Rows
'ici à chaque tour de boucle ..
' r.. représente une ligne du tableau..
 
If r.Cells(3) = 0 Then
If rADet Is Nothing Then
Set rADet = r
Else
Set rADet = Application.Union(rADet, r)
End If
Else
st = Cells(1, bColA).AddressLocal(False, False)
r.Cells(1) = LCase(Left(st, Len(st) - 1))
bColA = bColA + 1
 
End If
Next
If Not rADet Is Nothing Then rADet.Delete
'-------------------------------------------------------
Dim NomFichier As Variant
'NomFichier = "C:\Mes documents\aze.csv"
NomFichier = ThisWorkbook.Path & "\" & "aze.csv "
 
If NomFichier <> False Then
Application.DisplayAlerts = False
 
'----------------------------------------------------------
'Creation d'un fichier texte type .csv
 
Dim x, j, DernièreLigne, DernièreColonne
Application.ScreenUpdating = False
ActiveSheet.Range("A1").CurrentRegion.Select '*******
Set tbl = ActiveCell.CurrentRegion '*******
DernièreLigne = tbl.Rows.Count '*******
DernièreColonne = tbl.Columns.Count '*******
Cells(1, 1).Select
Open NomFichier For Output As #1
For x = 1 To DernièreLigne
Print #1, Cells(x, 1).Formula;
For j = 2 To DernièreColonne
Print #1, ";" + Cells(x, j).Formula;
Next j
Print #1, Cells(x, j + 1).Formula
Next x
Close #1
'-----------------------------------------------------------------
 
ActiveWorkbook.Close
Application.DisplayAlerts = True
Else
Exit Sub
End If
 
Application.ScreenUpdating = True
'-------------------------------------------------
' Demarrage de DebitPro avec activation d'importation
ChDrive "C"
ChDir "C:\Program Files\RozetUtil\DebitPro14"
Shell """C:\Program Files\RozetUtil\DebitPro14\debitpro.exe"""
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "%f", True
SendKeys "i", True
Sleep 10
'SendKeys "{tab 2}", True
SendKeys " ", True
SendKeys "{tab 3}", True
SendKeys "~", True
Sleep 1
SendKeys NomFichier, True
SendKeys "~", True
Sleep 1
SendKeys "{tab 3}", True
SendKeys "~", True
End Sub

st = Cells(1, bColA).AddressLocal(False, False)

Function EntCol(ByVal N As Long) As String
N = N - 1
If N > 25 Then EntCol = Chr$(N \ 26 + 64) & Chr$(N Mod 26 + 65) Else EntCol = Chr$(N + 65)
End Function

r.Cells(1) = LCase(EntCol(bColA))