Aktivieren eines Workbooks mit Platzhalter (VBA)

Question

Hallo,

war eigentlich ein schönes Wochenende, aber diese
Sache hat es mir vermiest.

Ich habe mit dem Makrorecorder einen Daten Import/Export aufgezeichnet. Es geht um 2 Exceldateien.

Das funktioniert auch sehr gut, wenn man den vollständigen Pfad angibt.

Habe gegoogelt und das hier noch gefunden:
************************************************************************
Datei = "März"
Path = "C:\Users\micha\Desktop\Aufträge\"
FilesInPath = Path & Dir$(Path & Datei & "*.xls*")

Workbooks.Open Filename:=FilesInPath

Sheets("Bestände").Select
*************************************************************************
Öffnen ist dann kein Problem, nur mit einem Platzhalter kann ich dieses Workbook nicht aktivieren, wenn vorher wieder zur Quelldatei gewechselt wurde.


Beispiel:
********************************************************************
So ist alles gut:

Windows("Aufträge März..xlsx").Activate

Sheets("Bestände").Select

*********************************************************************

*********************************************************************
So z.B.geht es nicht:

Windows(Files in Path) . Activate

Sheets("Bestände").Select

*********************************************************************

Weiß dafür jemand eine Lösung ?
Danke im Voraus.

Michael

Version Excel 2007 , OS = Windows 2007

Answer 1

hi all ^^

die worksheetvariante mit flexibler stichwoerteranzahl

gruss nighty

eventmodule noch hinzufuegen

Sub DateienLesen()
Call EventsOff
Dim Dname As String, Dpfad As String, DateiName As String
Dim Dmonat As Variant, Dh As Variant, Sh As Variant
Dname = "*.xls"
Dpfad = "D:\Temp\"
Dmonat = Array("MÄRZ", "Maerz") 'beliebig erweiterbar an stichwoertern
DateiName = Dir(Dpfad & Dname)
Do While DateiName <> ""
Workbooks.Open Filename:=Dpfad & DateiName
For Each Dh In Dmonat
For Each Sh In Worksheets
If UCase(Mid(Sh.Name, 1, Len(Dh))) = UCase(Dh) Then
Workbooks(DateiName).Worksheets(Sh.Name).Range("A1:A" & Workbooks(DateiName).Worksheets(Sh.Name).Range("A" & Rows.Count).End(xlUp).Row).Copy _
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1)
End If
Next
Next
Workbooks(DateiName).Close SaveChanges:=False
DateiName = Dir
Loop
Call EventsOn
End Sub