Kopiere Fanenavn oa.

Sub GemSinkelArk()
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=ActiveSheet.Name & Range("D1") & Range("H1") & ".xls"
    ActiveWindow.Close SaveChanges:=False
 
End Sub

du skal stå på det ark der skal kopieres og gemmes

Hej kabbak
Undskyld forsinkelsen.
Koden virker fint, Men.... den skal gemme den aktuelle mappe, og ikke oprette en ny mappe.
Dvs. at den ud fra indholdet i B2, H2 og I2 opretter et nyt ark med B2, H2 og I2's indhold, sammensat, som det nye navn som eks. "SofieNovember2005" i stedet for ark-et-eller-andet. Men i samme mappe.
Jeg beklager hvis jeg ikke fik udtrykt mig rigtigt.

på forhånd tak.

Jan

Sub GemSinkelArk()
Nytnavn = ActiveSheet.Name & Range("D1") & Range("H1")
  ActiveSheet.Copy After:=Sheets(ThisWorkbook.Sheets.Count)
  ActiveSheet.Name = Nytnavn
End Sub

Det virker rigtig fint, men når man vil rette arket igen, så kommer den op og siger at den ikke kan give det samme navn til det nye ark som det gamle... hvodan kommer man ud over det?
Og kan man få arkene sorteret alfabetisk når arkene har flere navne som f.eks Jonas, Nadia, osv.?

Jan

Her bliver arket slettet, hvis det er der i forvejen og arkene bliver sorteret til slut.


Sub GemSinkelArk()
Nytnavn = ActiveSheet.Name & Range("D1") & Range("H1")
Application.DisplayAlerts = False
If SheetExists(Nytnavn) Then Sheets(Nytnavn).Delete
Application.DisplayAlerts = True
  ActiveSheet.Copy After:=Sheets(ThisWorkbook.Sheets.Count)
  ActiveSheet.Name = Nytnavn
  Call SortSheets
End Sub

Private Function SheetExists(sname) As Boolean
'  Returns TRUE if sheet exists in the active workbook
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(sname)
    If Err = 0 Then SheetExists = True Else SheetExists = False
End Function
Public Sub SortSheets()
Dim lngSheet As Long
Dim objSheet As Worksheet

Dim lngLoop As Long
Dim objLoop As Worksheet
 
For lngSheet = 2 To ThisWorkbook.Sheets.Count
  Set objSheet = ThisWorkbook.Sheets(lngSheet)
  For lngLoop = 1 To lngSheet - 1
    Set objLoop = ThisWorkbook.Sheets(lngLoop)
   
    If objSheet.Name < objLoop.Name Then
      objSheet.Move objLoop
      lngLoop = lngSheet
    End If
  Next
Next
End Sub

Alletiders, men hvis man har rettet i arket angående timer, og så vil lave et nyt ark og har glemt at ændre i i B2, H2 og I2 så sletter den det nye ark, der hedder det samme som det gamle, ganske som den skal men rettelserne er jo så også væk,
Så at gemme må blive ved alm gem.
Så koden jeg egentlig "bare" har brug for er at den laver et nyt ark og så sorterer fanebladene (arkene)
Hvordan hægter jeg koden til sorteringen ind i Sinkel ark?

Call SortSheets

.

Tak for hjælpen kabbak ;-)