VBA - problème de ldénommination de dossier

Bonjour,

J'ai créé la macro suivante et j'ai un bug relatif à la dénomination et la fermeture du fichier.
franchement je n'arrive pas à identifier le problème. Est ce que quelqu'un voit une façon de resoudre le problème?

D'avance merci,


Sub TNAAggregation()


Dim i As Long
Dim j As Long
Dim k As Long
Dim wbName As String

j = 1

Application.Goto Worksheets(1).Range("E7")

For i = 7 To ThisWorkbook.Worksheets(1).Range("A65000").End(xlUp).Row
If Cells(i, 5) = Cells(i + 1, 5) Then

'===================================================================
'Adds a new workbook
Workbooks.Add
Application.Goto ThisWorkbook.Worksheets(1).Range("E7")
'===================================================================

If ThisWorkbook.Worksheets(1).Cells(i, 3) < ThisWorkbook.Worksheets(1).Cells(i + 1, 3) Then
'Take C
Workbooks(2).Worksheets(1).Cells(j, 1) = ThisWorkbook.Worksheets(1).Cells(i, 8)

ElseIf (ThisWorkbook.Worksheets(1).Cells(i, 3) > ThisWorkbook.Worksheets(1).Cells(i + 1, 3)) _
And ThisWorkbook.Worksheets(1).Cells(i, 3) < 37226 Then
'Take C
Workbooks(2).Worksheets(1).Cells(j, 1) = ThisWorkbook.Worksheets(1).Cells(i, 8)

ElseIf (ThisWorkbook.Worksheets(1).Cells(i, 3) > ThisWorkbook.Worksheets(1).Cells(i + 1, 3)) _
And ThisWorkbook.Worksheets(1).Cells(i, 3) > 37226 Then
Workbooks(2).Worksheets(1).Cells(j, 1) = ThisWorkbook.Worksheets(1).Cells(i + 1, 8)

Else: Workbooks(2).Worksheets(1).Cells(j, 1) = ThisWorkbook.Worksheets(1).Cells(i, 8)

End If


For k = 22 To 110
If IsEmpty(Cells(i, k)) And IsEmpty(Cells(i + 1, k)) Then
Else:
Workbooks(2).Worksheets(1).Cells(j, 2) = ThisWorkbook.Worksheets(1).Cells(6, k)
Workbooks(2).Worksheets(1).Cells(j, 4) = ThisWorkbook.Worksheets(1).Cells(i, k).Value + ThisWorkbook.Worksheets(1).Cells(i + 1, k).Value
j = j + 1
End If
Next

j = 1

Workbooks(2).Worksheets(1).Cells(1, 3) = "EUR"

Application.Goto Workbooks(2).Worksheets(1).Range("A1")

Workbooks(2).Worksheets(1).Range("A1").Copy
Workbooks(2).Worksheets(1).Range("A1:A" & Workbooks(2).Worksheets(1).Range("B65000").End(xlUp).Row).Select
ActiveSheet.Paste

Workbooks(2).Worksheets(1).Range("C1").Copy
Workbooks(2).Worksheets(1).Range("C1:C" & Workbooks(2).Worksheets(1).Range("B65000").End(xlUp).Row).Select
ActiveSheet.Paste

Workbooks(2).Worksheets(1).Columns("B:B").NumberFormat = "m/d/yyyy"
Application.Goto Workbooks(2).Worksheets(1).Range("A1")

wbName = ThisWorkbook.Worksheets(1).Cells(i, 5) & " - " & Workbooks(2).Worksheets(1).Range("A1")

'===================================================================
'You can change the file path where the " & " starts and stops
ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\Paris1\Desktop\TNA Aggregation\" & wbName & ".csv", _
FileFormat:=xlCSV
'===================================================================

Application.DisplayAlerts = False
Workbooks(wbName).Close
Application.DisplayAlerts = True

End If

Next

End Sub