lægge et tal til filnavnet

Public Sub shpTest_SaveFile()
' -----------------------------------------------------------------------------------
' Purpose    :
' Parameters :
' Created    : 01-29-04
' Modified  :
' Remarks    :
' -----------------------------------------------------------------------------------
On Error GoTo Error_shpTest_SaveFile
  Dim sti As String, Navn As String
  Dim strFileName As String
  Dim intX As Integer
  Dim bolFound As Boolean
 
  If Range("C9").Value = "" And Range("D9").Value = "" Then
    MsgBox "Du mangler at indtaste dit navn og data", vbCritical
    Exit Sub
  End If
   
  If Range("D9").Value = "" Then
    MsgBox "du har ikke indtastet dit navn!", vbCritical
    Exit Sub
  End If
       
  If Range("C9").Value = "" Then
    MsgBox "du har ikke indtastet data", vbCritical
    Exit Sub
  End If
         
  sti = "c:\timeregistrering\" & Range("D9").Value & "\"
  Navn = Range("D9").Value & "_" & Range("E9").Value
   
  If Dir("c:\timeregistrering", vbDirectory) = "" Then MkDir "c:\timeregistrering\"
  If Dir(sti, vbDirectory) = "" Then MkDir sti
   
  bolFound = True
  intX = 1
  strFileName = Navn & "_" & intX & ".txt"
  Do While bolFound = True
    With Application.FileSearch
      .NewSearch
      .LookIn = sti
      .SearchSubFolders = False
      .Filename = strFileName
      .MatchTextExactly = False
      .Execute
      If .FoundFiles.Count > 0 Then
        intX = intX + 1
        strFileName = Navn & "_" & intX & ".txt"
      Else
        bolFound = False
      End If
    End With
  Loop
Debug.Print strFileName
   
  Sheets("Timer").Select
  Range("B9:B20").Select
  Selection.Copy
  Sheets.Add After:=Sheets(Sheets.Count) 'indsætter et nyt ark og lader programmet tælle nummeret på arket
  Sheets(Sheets.Count).Select
  Range("A1").Select
  ActiveSheet.Paste ' indsætter det kopierede materiale fra Det originale ark
  Application.CutCopyMode = False
  Application.DisplayAlerts = False
  ActiveSheet.SaveAs Filename:=sti & strFileName
 
'  , FileFormat:=xlText

MsgBox sti & strFileName
         
  Sheets("Timer").Select
   
  Sheets(Sheets.Count).Delete 'sletter det oprettede ark og lukker Microsoft Excel
  Range("B8").Select

Exit_shpTest_SaveFile:
  Exit Sub

Error_shpTest_SaveFile:
  Select Case Err.Number
    Case 2501
    Case 3021
    Case Is < 0
    Case Else
      MsgBox Err.Number & ": " & Err.Description, vbOKOnly + vbCritical, "Error in procedure 'shpTest_SaveFile'"
  End Select
  Resume Exit_shpTest_SaveFile

End Sub

Der er dog et par issues

Den vil ikke gemme som txt
Det resulterer i at du ender med at have arket du lige har gemt åben.

Jeg kan ikke huske hvordan det lige er man fikser det, men jeg har et eksempel der hjemme der gør det.

Sheets("Timer").Select
    Range("B9:bund").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count) 'indsætter et nyt ark og lader programmet tælle nummeret på arket
    Sheets(Sheets.Count).Select
    Range("A1").Select
    ActiveSheet.Paste ' indsætter det kopierede materiale fra Det originale ark
    Application.CutCopyMode = False
    Application.DisplayAlerts = False

nr = ""
i = 0
Do
Fundet = (Dir(sti & Navn & nr & ".txt"))
Snavn = Navn & nr & ".txt"
If Fundet <> Snavn Then ' tjekker om den eksisterer
Exit Do
End If
i = i + 1
nr = " " & i
Loop

ActiveSheet.SaveAs Filename:=sti & Navn & nr, FileFormat:=xlText
         
    Sheets("Timer").Select
   
    Sheets(Sheets.Count).Delete 'sletter det oprettede ark og lukker Microsoft Excel
    Range("B8").Select

Perfekt kabbak. Tak. Smid svar for point

et svar ;-))

takker