title image


Smiley war mein fehler hat schon gepasst nur das save hat gefehlt
hi



Sub ff()

wkb = ThisWorkbook.Name 'ermitteln des aktuellen mappennamen 'ist optional das heisst

'wkb="name der mappe" '-kann durch das ersetzt werden

zellname = Sheets("Rechnungserstellung").Cells(17, 10).Value 'oder auch sheets(1) wenn es die erste tabelle in diesem Blatt ist

'.Activate 'kann wegfallen 'und naturilich auch das with

'zellname = der wert der zelle J17

dpath = "C:\" 'anpassen

Workbooks.Add 'neue arbeitsmappe wird erstellt

'und danach gespeichert

ActiveWorkbook.SaveAs dpath & zellname & ".xls" 'bei dem xls bin ich mir nicht sicher brauch es aber bei diesenm rechner da ich die dateierweiterungen eingeschaltet habe

Workbooks(wkb).Activate 'aktiviere "alte" Mappe

Sheets("Rechnungserstellung").Copy Before:=Workbooks(zellname & ".xls").Sheets(1) 'kopiert das Blatt

ActiveWorkbook.Save 'speichern der mappe

Workbooks(zellname & ".xls").Activate ' neue mappe aktivieren

Application.DisplayAlerts = False 'warnmeldungen ausschalten

For Each blatti In Workbooks(zellname & ".xls").Worksheets 'durchsuche alle blätter

If blatti.Name "Rechnungserstellung" Then 'heisst dein blatt so!!!!!!!!'sonst anpassen

blatti.Select 'wähle es aus

ActiveWindow.SelectedSheets.Delete 'lösche es

End If

Next

Workbooks(zellname & ".xls").Save 'speichern

Workbooks(zellname & ".xls").Close 'schliessen

End Sub





So geht es BEI mir

hab es ein wenig dokumentiert *g*

Gruß

Christian
Feedback nicht vergessen ! Gutes gelingen wünscht Chris

I didn't write this; a very complex macro did.

0110110001101001011001010110001001100101001000000110011101110010111111001101111101100101001000000110001101101000011100100110100101110011

geschrieben von


Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: