Tabellenblatt als Arbeitsmappe unter neuem Namen

Forumthread: Tabellenblatt als Arbeitsmappe unter neuem Namen

31.03.2015 13:16:15

Florian

Hallo,
leider konnte ich im Forum keine Antwort auf meine Fragestellung finden.
Ich möchte über eine Makro ,die Werte aus einer von mir gewählten Zeile in Tabelle 2 in bestimmte Zellen kopieren (siehe Tabelle 2).
Desweiteren möchte ich das ich sobald ich die Werte in Tabellenblatt 2 kopiert wurden, Tabellenblatt 2 als eine neue Arbeitsmappe gespeichert wird. Der Name dieser Datei (Arbeitsmappe) soll sich aus Zellennamen der Tabelle 1 zusammensetzen, zb. HansSchuh1.xlsm.
Optimal wäre es wenn in der selben Zeile , zb in diesem Fall in Zelle G5 ein Hyperlink zur eben erzeugten Datei erstellt werden würde.
Dies alles am besten als eine Makro über ein Steuerelement.
Ich habe hierfür eine Beispieldatei erstellt.
Vielen Dank schon mal für eure Hilfe

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Tabellenblatt als Arbeitsmappe unter neuem Namen

31.03.2015 13:17:09

Florian
AW: Tabellenblatt als Arbeitsmappe unter neuem Namen

01.04.2015 17:52:54

Klexy

AW: Tabellenblatt als Arbeitsmappe unter neuem Namen

31.03.2015 13:17:09

Florian

hier die Datei: https://www.herber.de/bbs/user/96763.xlsm

AW: Tabellenblatt als Arbeitsmappe unter neuem Namen

01.04.2015 17:52:54

Klexy

So müsste das gehen:

Sub übertragen()
Dim aProjekt As Integer, aBearbeiter As String, aProdukt As String
Dim bProjekt As Range, bBearbeiter As Range, bProdukt As Range
Dim bPfad As String, bName As String
Pfad = "H:\Excel\Herber\" 'anpassen!
Dim ws As Worksheet
Dim bBlatt As String
bBlatt = "Tabelle2"
Dim Hier As Range
Set Hier = ActiveCell
aProjekt = Cells(Hier.Row, 1).Value
aBearbeiter = Cells(Hier.Row, 2).Value
aProdukt = Cells(Hier.Row, 3).Value
'prüft, ob eine Zeile mit Daten markiert wurde
If aProjekt = 0 Or aBearbeiter = "" Or aProdukt = "" Then
MsgBox "Kein gültiger Datensatz markiert"
Exit Sub
End If
bName = aBearbeiter & aProdukt & aProjekt & ".xlsm"
Set bProjekt = Sheets(bBlatt).Range("C6")
Set bBearbeiter = Sheets(bBlatt).Range("C4")
Set bProdukt = Sheets(bBlatt).Range("E4")
bProjekt = aProjekt
bBearbeiter = aBearbeiter
bProdukt = aProdukt
ActiveWorkbook.Save 'speichert Original-Datei
'löscht alle Blätter außer Tabelle2
For Each ws In ThisWorkbook.Worksheets
Application.DisplayAlerts = False
If ws.Name = bBlatt Then
Else
ws.Delete
End If
Application.DisplayAlerts = True
Next
'speichert die übriggebliebene Rumpfdatei unter dem neuen Namen
ChDir Pfad
ActiveWorkbook.SaveAs Filename:=bPfad & bName, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

Beliebteste Forumthreads (12 Monate)

Tabellenblatt als Arbeitsmappe unter neuem Namen

Forumthread: Tabellenblatt als Arbeitsmappe unter neuem Namen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread