Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1416to1420
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabellenblatt als Arbeitsmappe unter neuem Namen

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
Anzeige
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

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige