créé n onglets dans un fichier a partir de n fichiers ascii

Sub MacroCreOnglet()
'
' Macro enregistrée le 15/01/2010 par sgouzien
' Cette macro créé des onglets dans un fichier station.xls a partir
' de fichiers ascii se trouvant dans un répertoire /travail de newdata
' Dans notre cas les noms des fichiers sont composes ainsi dn401.ctd
' et jusqu'a dn459.ctd avec des numeros qui ne se suivent pas. Il n'y a
' que 51 fichiers dans le répertoire.

Dim i As Integer
Dim tt As String

On Error Resume Next

i = 1
j = 401
k = 1
For i = 1 To 60

    Workbooks.OpenText Filename:="R:\newdata\dino4\ctd\travail\dn" & j & ".ctd", _
        Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
'Workbooks.OpenText OuvF, xlWindows, , , , , True
'If Err <> 0 Then MsgBox Err & "Vous n'avez choisi un fichier texte valide"
'If Err = 0 Then
'Workbook.ActiveSheet.Copy
'Workbook("R:\newdata\dino4\ctd\travail\dn" & j & ".ctd").ActiveSheet.Copy
'Application.CutCopyMode = False
'tt = ActiveWorkbook.ActiveSheet.Name
'tt = Workbooks("stations.xls").Sheets(i - 7).Name
If ActiveWorkbook.ActiveSheet.Name = "dn" & j Then
   ActiveWorkbook.ActiveSheet.Move Before:=Workbooks("station.xls").Sheets(k)
   k = k + 1
End If
'Workbooks("R:\newdata\dino4\ctd\travail\dn" & j & ".ctd").Close
'ActiveWorkbook.Close
'End If
     j = j + 1
  
Next

End Sub

Function OuvF()
OuvF = Application.GetOpenFilename("Fichier Texte (*.txt), *.txt")
End Function