Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 18:41:19
vba Zeilen duplizieren ab aktiver Zeile bis letzte Zeile
25.04.2024 18:22:55
Zeilen mit bestimmtem Datum in andere Mappe übertragen
25.04.2024 18:14:45
VBA - Excell - Kopie und "Diebstahl" Schützen
25.04.2024 17:49:39
Bedingte Formatierung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
924to928
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
924to928
924to928
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Workbook finden

Workbook finden
14.11.2007 16:49:00
volker
Hai Leute,
in einem definiertem Ordner liegen viele Excel Dateien, z.B. eine mit Namen "Volker".
Ich möchte über ein Auswahlfeld, in welches ich den Dateinamen eingebe die jeweilige Datei öffnen.
Also: ich starte das Makro gebe "Volker" ein und die Datei wird dann geöffnet.
Hat jemand eine Idee oder Bespielmappe ?
Besten Dank Gruss volker

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Workbook finden
14.11.2007 17:10:00
Renee
Hi Volker,
Diese Makro in ein Standardmodul:

Private Sub Optimal()
Dim tName As Variant
Const tDir = "G:\Definierter\Ordner\"
On Error GoTo i_warn_you
please_repeat:
tName = InputBox("Bitte den Dateinamen eingeben", "Exceldatei öffnen", "Volker")
If tName  "" Then
Workbooks.Open (tDir & tName & ".xls")
End If
Exit Sub
i_warn_you:
tName = MsgBox("Datei " & tName & ".xls nicht gefunden!" & vbCrLf & _
"Wollen Sie eine andere Datei versuchen?", vbYesNo + vbExclamation, "Datei öffnen")
If tName = vbYes Then GoTo please_repeat
End Sub


Vorher ggf. die "String-Expression" anpassen.
GreetZ Renee

Anzeige
AW: Workbook finden
15.11.2007 07:39:53
volker
Hallo Renee,
absolut perfekt!!
Hast Du Lust es noch ein bisschen abzuwandeln?
Ich möchte die gefundene Datei nicht "wirklich" öffnen, sondern das 2. Worksheet kopieren und im atuellen Workbook an 2. Stelle einfügen.
Danke Viele Grüsse volker

AW: Workbook finden
15.11.2007 07:52:00
volker
Hallo Renee,
ist es möglich auch in Unterordnern die Datei zu finden? sowie die Dateiendung auch auf *.xlsm zu erweitern?
Danke Gruss volker

AW: Workbook finden
15.11.2007 14:33:00
Renee
Hi Volker,
Mehr Wünsche... mehr Code:

Sub Optimal()
Dim tName As Variant
Dim tOpenThis As String
Dim tSubDir As String
Dim objFS As Object
Const tDir = "C:\Definiertes\Verzeichnis\"
do_it_again:
Set objFS = CreateObject("Scripting.FileSystemObject")
tName = InputBox("Bitte den Dateinamen eingeben", "Exceldatei öffnen", "Volker")
If tName  "" Then
tSubDir = Dir(tDir, vbDirectory)
Do While tSubDir  "" And tOpenThis = ""
If tSubDir  "." And tSubDir  ".." And _
(GetAttr(tDir & tSubDir) And vbDirectory) = vbDirectory Then
If objFS.fileExists(tDir & tSubDir & "\" & tName & ".xls") Then
tOpenThis = tDir & tSubDir & "\" & tName & ".xls"
End If
If objFS.fileExists(tDir & tSubDir & "\" & tName & ".xlsm") Then
tOpenThis = tDir & tSubDir & "\" & tName & ".xlsm"
End If
End If
tSubDir = Dir
Loop
If tOpenThis = "" Then
tName = MsgBox("Datei " & tName & ".xls nicht gefunden!" & vbCrLf & _
"Wollen Sie eine andere Datei versuchen?", vbYesNo + vbExclamation, "Datei ö _
ffnen")
If tName = vbYes Then GoTo do_it_again
Else
tName = ActiveSheet.Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Workbooks.Open (tOpenThis)
ActiveWorkbook.Sheets(2).Cells.Copy
ActiveWorkbook.Close SaveChanges:=False
ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(1)
ThisWorkbook.Sheets(2).Paste
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
ThisWorkbook.Sheets(tName).Activate
End If
End If
End Sub


GreetZ Renee

Anzeige
AW: Workbook finden
15.11.2007 17:08:32
volker
Wow!!
Da bin ich platt!
Ich trau mich fast nicht mehr nochmals was nachzufragen:
zum 1. kann das kopierte und eingefügte sheet den Ursprungsnamen behalten?
und
in dem ausgewählten Workbook möchte ich aus dem 1. Worksheet den Spaltenbereich D:U ab Zeile 5 nach unten kopieren und zwar soviel Zeilen bis in der Zelle E leer ist. (Bsp.: hier stehen bestimmte Artikel, mal mehr mal weniger, und die Zelle "E" ist die Stückzahl Zelle. Wenn also "E" leer ist, ist auch meine Tabelle zu Ende)
Diesen Zellbereich möchte ich in meiner aktuellen Liste wieder von "D" aus einfügen. Zeile hier wieder erste leere Zelle "E"
Zum 2. kannst Du Dir auch vorstellen nebenher ein paar codes zu schreiben?
Vielen vielen Dank aus dem schneereichen Freudenstadt!
Gruss volker

Anzeige
AW: Workbook finden
15.11.2007 17:14:00
volker
Hai Renee,
ich hab was vergessen:
das zweite Sheet, welches kopiert wird und an 2. Postion eingefügt wird soll als ganz kopiert werden, nicht nur die Inhalte, sonder das Ganze Blatt so wie es aussieht.
Besten ´Dank Gruss volker

AW: Workbook finden
15.11.2007 22:00:00
Renee
Hi Volker,
...kannst Du Dir auch vorstellen nebenher ein paar codes zu schreiben?
Was verstehst Du darunter?
Wenn es Richtung Auftragsprogrammierung geht, kann frau darüber reden.
Wenn es Richtung "Ich brauchen, du Hobby, du mir gratis machen" Nein.
Das mit Deinen Änderungen kann ich ev. morgen anschauen.
GreetZ Renee

Anzeige
AW: Workbook finden
16.11.2007 07:39:18
volker
Hai Renee,
ich meinte eher das erstere, wer will sein Hobby schon zum Beruf machen.......
...meine Änderungen, das hört sich gut an.
Danke Gruss volker
v.weil@kappler.de

AW: Workbook finden
16.11.2007 11:18:00
Renee
Hi Volker,
So sieht der Code mit Deinen neuen Wünschen aus:

Sub Optimal()
Dim tName As Variant
Dim tOpenThis As String
Dim tSubDir As String
Dim lActLastRow As Long
Dim lThisLastRow As Long
Dim objFS As Object
Const tDir = "G:\AKROS\"
do_it_again:
Set objFS = CreateObject("Scripting.FileSystemObject")
tName = InputBox("Bitte den Dateinamen eingeben", "Exceldatei öffnen", "Volker")
If tName  "" Then
tSubDir = Dir(tDir, vbDirectory)
Do While tSubDir  "" And tOpenThis = ""
If tSubDir  "." And tSubDir  ".." And _
(GetAttr(tDir & tSubDir) And vbDirectory) = vbDirectory Then
If objFS.fileExists(tDir & tSubDir & "\" & tName & ".xls") Then
tOpenThis = tDir & tSubDir & "\" & tName & ".xls"
End If
If objFS.fileExists(tDir & tSubDir & "\" & tName & ".xlsm") Then
tOpenThis = tDir & tSubDir & "\" & tName & ".xlsm"
End If
End If
tSubDir = Dir
Loop
If tOpenThis = "" Then
tName = MsgBox("Datei " & tName & ".xls nicht gefunden!" & vbCrLf & _
"Wollen Sie eine andere Datei versuchen?", _
vbYesNo + vbExclamation, "Datei öffnen")
If tName = vbYes Then GoTo do_it_again
Else
tName = ActiveSheet.Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Workbooks.Open (tOpenThis)
tOpenThis = ActiveWorkbook.Name
lActLastRow = ActiveWorkbook.Sheets(1).Range("E" & _
ActiveWorkbook.Sheets(1).Rows.Count).End(xlUp).Row
lActLastRow = IIf(lActLastRow


GreetZ
Userbild

Anzeige
AW: Workbook finden
16.11.2007 11:32:00
volker
DANKE, genial
Gruss volker

AW: Workbook finden
16.11.2007 12:18:14
volker
Hai Renne,
oh ich seh da noch was das Du vielleicht noch anpassen könntest.
Und zwar wird der Zellbereich richtig kopiert und auch eingefügt, wenn ich aber den nachsten Bereich einfügen lasse (neue Datei) wird der nun kopierte Bereich mit einer Leerzeile zum obigen eingefügt und in Spalte "E" dieser Leerzeile (oder "fast" Leerzeile) hab ich eine 1
hmmm......
Besten Dank Gruss volker

AW: Workbook finden
16.11.2007 13:28:44
Renee
Hi Volker,
Sorry, ich kann deinen "Fehler" nicht rekonstruieren.
Ich hab's auf alle erdenklichen Arten probiert. V.a. mit und ohne Daten in der Quelldatei.Tabelle1
Bist Du sicher, dass diese ominöse 1 nicht aus der Quelldatei stammt?
Oder wird diese 1 ev. durch eine Formel? erzeugt. Denn jetzt wird 1:1 kopiert, d.h. nicht Werte, sondern eff. Zellinhalte.
GreetZ Renee

Anzeige
AW: Workbook finden
16.11.2007 15:20:00
volker
Hai Renee,
ich überprüf mal alles ordentlich, dann meld ich mich wieder.
Danke schönes WE Gruss volker

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige