Pfadnamen und Teilnamen der Arbeitsmappe auslesen

Hallo,
über ein Makro öffne ich die Excel Datei "Tierfreunde_Mitglieder.xls" und befülle diese mit Daten aus einer anderen Datei (auch über Marko), was auch wunderbar klappt.
Aus der gleichen Quelldatei befülle ich dann die Datei "Tierfreunde_Rassenvorliebe" (Klappt auch).
Da sich aber irgendwand der Name Tierfreund in Reptilienfreund_Mitglieder ändern kann, möchte ich das Makro so ändern, daß es sich nach der ersten Auswahl einer Arbeitsmappe den Pfad und die ersten 10 Buchstaben der zuerst aufgerufenen Arbeitsmappe merkt und dann diesen zum Öffnen der weiteren Arbeitsmappe voranstellt?
z.B Tierfreunde_Mitglieder.xls wird geöffnet ( Merke D:\Tierfreund) und dann öffnen
D:\Tierfreund+_Rassenvorliebe.
Der vordere Namen (10 Stellen) kann sich ändern, der hintere Namen bleibt konstant.
Ich hoffe, jemand hat eine für mich verständliche Idee, bzw. Lösung
Bernhard

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sorry,
ich habe mich etwas unverständlich ausgedrückt.
Sub Tierfreund_Importe()
Dim xlursprung As String '
MsgBox "Wählen sie im folgenden Fenster die Tiefreund_Tabelle aus!", vbInformation, "Hinweis"
dlganswer = Application.GetOpenFilename("Text Files (*.xls), *.xls")
'dlganswer = Application.GetOpenFilename
If dlganswer = False Then Exit Sub
Workbooks.OpenText Filename:=dlganswer, Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 2), _
Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), _
Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15 _
, 2), Array(16, 2), Array(17, 2), Array(18, 2), Array(19, 2), Array(20, 2), Array(21, 2), _
Array(22, 2), Array(23, 2), Array(24, 2), Array(25, 2), Array(26, 2), Array(27, 2), Array( _
28, 2), Array(29, 2), Array(30, 2), Array(31, 2), Array(32, 2), Array(33, 2), Array(34, 2), _
Array(35, 2), Array(36, 2), Array(37, 2), Array(38, 2), Array(39, 2), Array(40, 2), Array( _
41, 2), Array(42, 2), Array(43, 2), Array(44, 2), Array(45, 2), Array(46, 2), Array(47, 2), _
Array(48, 2), Array(49, 2), Array(50, 2), Array(51, 2), Array(52, 2)), _
TrailingMinusNumbers:=True
'Anzeigen der ausgewählten Datei
überprüf = MsgBox(dlganswer, vbYesNo + vbExclamation, "Dateiauswahl korrekt ?")
If überprüf = 7 Then
MsgBox "zuvor geöffnete Tabelle schließen !", , "Falsche Auswahl !"
Exit Sub
End If
If überprüf = 6 Then
End If
ActiveWorkbook.SaveAs Filename:=Left(ActiveWorkbook.Path, var) & "Tierfreund\" & datum1 & " " & "Tierfreund_Tabelle" & ".txt", FileFormat:=xlText
Range("A1").Select
'Daten sortieren nach Kriterium "Name" und "Vorname"
Range("A:h").Select
Selection.Sort Key1:=Range("b2"), Order1:=xlAscending, Key2:=Range("b2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption1:=xlSortTextAsNumbers
Range("A1").Select
'Zellbereiche der Ursprungsdatei bestimmen und Variable-Namen vergeben
'Variablen laden
ursprung = ActiveWorkbook.Name
ActiveCell.SpecialCells(xlLastCell).Select
Y = ActiveCell.Row
z = ActiveCell.Column
'1.Spalte einlesen
Dim QuellVary As Variant
Range("A2").Select
ReDim QuellVary(Y - 1, 9)
'Namensvarialbe für Text "Tierfreund" bestimmen
For I = 0 To Y - 1
QuellVary(I, 9) = "Tierfreund"
'Tel-Nr. in Spalte A (0)
QuellVary(I, 0) = ActiveCell.Text
ActiveCell.Offset(0, 1).Activate
'Name in Spalte B (1)
QuellVary(I, 1) = ActiveCell.Value
ActiveCell.Offset(0, 1).Activate
'Vorname in Spalte C (2)
QuellVary(I, 2) = ActiveCell.Value
ActiveCell.Offset(0, 1).Activate
'PLZ in Spalte D (3)
QuellVary(I, 3) = ActiveCell.Value
ActiveCell.Offset(0, 1).Activate
'Wohnort in Spalte E (4)
QuellVary(I, 4) = ActiveCell.Value
ActiveCell.Offset(0, 1).Activate
'Strasse in Spalte F (5)
QuellVary(I, 5) = ActiveCell.Value
ActiveCell.Offset(0, 1).Activate
'Rasse in Spalte G (6)
QuellVary(I, 6) = ActiveCell.Value
ActiveCell.Offset(0, 1).Activate
'________________________________________________________________________________
'Zu ladende Datei wird geöffnet - aufgerufen
'Tierfreund_Mitglieder.xls wird aufgerufen
'---------------------------------------------------------------------------------------------------------------------------
Hier will ich dann eine neue msgbox einfügend und z.B. die Datei D:\Tierfreund_Mitglieder.xls aufrufen.
Die ersten 10 buchstaben soll sich eine Variable merken und später
--------------------------------------------------------------------------------------------------------
Workbooks.Open Filename:=ThisWorkbook.Path & "\Tierfreund_Mitglieder"
TriefreundMitgl = ActiveWorkbook.Name
'Alle Zellen auf "Text" formatieren
Cells.Select
Selection.NumberFormat = "@"
'Zelle C8 - ab welcher der Namen (Nam) eingefügt werden sollen - wird aufgerufen
'Daten werden eingefügt
Range("c8").Select
For Nam = 0 To Y - 1
ActiveCell = QuellVary(Nam, 1)
ActiveCell.Offset(1, 0).Activate
Next Nam
'Zelle E8 - ab welcher die "Vornamen" (VorN) eingefügt werden sollen - wird aufgerufen
'Daten werden eingefügt
Range("e8").Select
For VorN = 0 To Y - 1
ActiveCell = QuellVary(VorN, 2)
ActiveCell.Offset(1, 0).Activate
Next VorN
..... usw. usw...................
'------------------------------------------------------------------------------------------------
'Zu ladende Datei wird geöffnet - aufgerufen
'Tierfreund_Rassenvorliebe.xls wird aufgerufen und befüllt.
----------------------------------------------------------------------------
Workbooks.Open Filename:=ThisWorkbook.Path & "\.........._Rassenvorliebe"
Vorliebe = ActiveWorkbook.Name
Range("e8").Select
For Rasse = 0 To Y - 1
ActiveCell = QuellVary(Rasse, 2)
ActiveCell.Offset(1, 0).Activate
Next Rasse
..... usw. usw.........
Ich möchte quasi das Makro auf für andere Tabellen benutzten. So wie ich es jetzt habe, muss ich immer die Namen der zu befüllenden Tabellen für den Aufruf ändern - ärgerlich :-(
Gruß Bernhard

Beliebteste Forumthreads (12 Monate)

Pfadnamen und Teilnamen der Arbeitsmappe auslesen

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread