Matthias hat mir letzte Woche schon recht weit mit der Exportfunktion geholfen, so dass ich selbst versucht habe eine Importfunktion zu programmieren. Hierbei muss ich jedoch einen festen Namen beim Export definieren. Zumindest kann ich verschiedene Ordner auswählen. Die Vergabe eines festen Namens ermöglicht, dass ich zwischen den Dateien wechseln kann und aus der Auslagerungsdatei nur bestimmte Bereiche wieder in die Ursprungsdatei importieren kann.
In meinem Fall brauche ich jedoch eine Importfunktion, die unabhängig vom Namen funktioniert, d.h. dass der Name frei wählbar ist.
Tabelle 1 (Name1) und 7 Name7)sollen aus meinem Tool exportiert werden. Hier muss kein Bereich definiert werden.
Beim Import hingegen dürfen nur bestimmte Bereiche aus der ausgelagerten Datei importiert werden.
Wie gesagt, unten stehende Makros funktionieren, wenn ich beim Export und beim Import von festen Dateinamen ausgehen. Ich brauche jedoch die Möglichkeit, dass ich unabhängig vom Dateinamen die entsprechenden Bereiche importieren kann.
Ich hoffe, Ihr habt einen Tip für mich.
Anbei nochmals die Makros:
Option Explicit
Sub Exportieren()
Dim fn As String
Dim wb_dest As Workbook, wb_new As Workbook
'Dateiname abfragen
fn = Application.GetSaveAsFilename(InitialFilename:="Auslagerung.xls", _
fileFilter:="Excel-Arbeitsmappe (*.xls), *.xls")
'Blätter in neue Mappe kopieren:
Application.ScreenUpdating = False
Set wb_dest = ActiveWorkbook
Sheets(Array("Tabelle1", "Tabelle7")).Copy
With ActiveWorkbook
.SaveAs Filename:=fn
.Close
End With
Application.ScreenUpdating = True
End Sub
Sub importieren()
Dim fn As String
'Dateiname abfragen
fn = Application.GetOpenFilename(fileFilter:="Excel-Arbeitsmappe (*.xls), *.xls")
'Blätter/ Bereiche in Quelldatei kopieren:
Application.ScreenUpdating = False
Workbooks.Open ("Auslagerung.xls")
Windows("Auslagerung.xls").Activate 'Auslagerungsdatei
Sheets("Tabelle1").Select
Range("C12:H36").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer.xls").Activate 'Quelldatei/ Tool
Sheets("Tabelle1").Select
Range("C12:H36").Select
ActiveSheet.Paste
Windows("Auslagerung.xls").Activate
Sheets("Tabelle7").Select
Range("C8:H25").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Transfer.xls").Activate
Sheets("Tabelle7").Select
Range("C8:H25").Select
ActiveSheet.Paste
MsgBox "Die Daten wurden erfolgreich Importiert!"
End Sub
Grüße
Uwe