von Tino habe ich vor kurzem untenstehenden Code erhalten. Funktioniert tip top. Nun habe ich aber einen individuellen Pfad nähmlich: I:\Rapporte\Gedruckt Wie muss ich nun diesen Pfad in den Code einfügen? Vielen Dank für die Hilfe,
Roger
Sub Kopieren()
Dim objDatei As Workbook
Dim SelBereich As Range
Dim i As Integer
Dim strDateiname As String, strPfad As String
'Dateiname
strDateiname = Range("C4") & Range("D16") & ".xls"
'Pfad
strPfad = Environ$("USERPROFILE")
If Right$(strPfad, 1) = "\" Then strPfad = Left$(strPfad, Len(strPfad) - 1)
strPfad = Left$(strPfad, InStrRev(strPfad, "\")) & "Administrator\Eigene Dateien\Raporte\"
Set SelBereich = Range("A1:G27")
Set objDatei = Workbooks.Add
'nicht benötigte Tabellen löschen
Application.DisplayAlerts = False
For i = objDatei.Sheets.Count To 2 Step -1
objDatei.Sheets(i).Delete
Next i
Application.DisplayAlerts = True
'Bereich kopieren
SelBereich.Copy objDatei.Sheets(1).Range("A1")
'Datei speichern unter
objDatei.SaveAs strPfad & strDateiname
'Datei schließen
objDatei.Close False
End
Sub
Option Explicit
Sub Kopieren()
Dim objDatei As Workbook
Dim SelBereich As Range
Dim i As Integer
Dim strDateiname As String
'hier Pfad angeben, beachte abschließen mit \
Const strPfad As String = "I:\Rapporte\Gedruckt\"
'Dateiname
strDateiname = Range("C4") & Range("D16") & ".xls"
Set SelBereich = Range("A1:G27")
Set objDatei = Workbooks.Add
'nicht benötigte Tabellen löschen
Application.DisplayAlerts = False
For i = objDatei.Sheets.Count To 2 Step -1
objDatei.Sheets(i).Delete
Next i
Application.DisplayAlerts = True
'Bereich kopieren
SelBereich.Copy objDatei.Sheets(1).Range("A1")
'Datei speichern unter
objDatei.SaveAs strPfad & strDateiname
'Datei schließen
objDatei.Close False
End Sub
Gruß Tino
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen