Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1812to1816
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
1812to1816
1812to1816
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bereich Kopieren aus nicht offener Datei

Bereich Kopieren aus nicht offener Datei
16.02.2021 14:18:52
Dieter(Drummer)
Guten Tag Spezialisten-/innen.
Mit beiliegendem Code, aus diesem Forum, von WernerB., vom 16.12.2005,
kann man Daten, aus definiertem Bereich, aus nicht geöffneter Datei, in aktuelle Datei (aktuelles Worksheet), einfügen. Das funktioniert.
Leider wird der Bereich aber nur im selben Bereich ins aktuelle Tabellenblatt eingefügt und ist nicht variabel.
Was, wie und wo muss der Code geändert werden damit der Bereich, wo es eingefügt werden soll,
frei gewählt werden kann? Meine Versuche, der Bereich zum einfügen frei zu wählen, war erfolglos.
Es sollte auch möglich sein, die Verknüpfung nur als Wert einzufügen.
Mit der Bitte um Hilfe,
grüßt, Dieter(Drummer)
Beispieldatei: https://www.herber.de/bbs/user/143968.xlsm
Code aus Modul1:
''In diesem Beispiel bleibt die Quell-Mappe geschlossen.
'In diesem Beispiel liegen Quell- und Zielmappe im gleichen Verzeichnis. 
Sub AuslesenGeschlDatei()
Dim rng As Range, _
sFile As String, sPath As String, _
oldStatusBar As Boolean
Application.ScreenUpdating = False
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
sFile = "TestKopie_1" 'geschlossene Datei
sPath = ThisWorkbook.Path & "\" 'im gleichen Ordner wie aktuelle, geöffnete Datei
Application.StatusBar = "Daten werden importiert. Bitte warten..."
With Sheets(1) 'Quelltabelle wird nicht geöffnet
.Range("A1:A3").Formula = "='" & sPath & "[" & sFile & _
"]Tabelle1'!A1:A3"
Set rng = .Range("A1:A3") 'aktuelle geöffnete ZielTabelle
End With
rng.Cells(1).Copy rng
rng.Value = rng.Value
Application.ScreenUpdating = True
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: Bereich Kopieren aus nicht offener Datei
16.02.2021 14:42:07
Rudi
Hallo,
sollte einfach so gehen:
Sub AuslesenGeschlDatei()
Dim sFile As String, sPath As String, _
oldStatusBar As Boolean
Application.ScreenUpdating = False
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
sFile = "TestKopie_1" 'geschlossene Datei
sPath = ThisWorkbook.Path & "\" 'im gleichen Ordner wie aktuelle, geöffnete Datei
Application.StatusBar = "Daten werden importiert. Bitte warten..."
With Sheets(2).Range("C6:C8")
.Formula = "='" & sPath & "[" & sFile & "]Tabelle1'!A1"
.Value = .Value
End With
With Application
.ScreenUpdating = True
.StatusBar = False
.DisplayStatusBar = oldStatusBar
End With
End Sub

Gruß
Rudi
Anzeige
AW: Danke Rudi, perfekte Lösung. Muss aber ...
16.02.2021 14:57:44
Dieter(Drummer)
... die zu kopierenden und einzufügenden Bereiche im Code angeben und kann sie nicht frei, ausserhalb des Codes, festlegen. Ist aber kein Problem.
Vielen Dank für praktikable und gute Lösung.
Gruß, Dieter(Drummer)
auch das sollte gehen
16.02.2021 15:22:54
Rudi
was stellst du dir vor?
sowas? 
Sub AuslesenGeschlDatei()
Dim sFile As String, sPath As String, _
oldStatusBar As Boolean
Dim rng As Range
On Error Resume Next
Set rng = Application.InputBox("Bereich:", "Bereichsauswahl", , , , , , 8)
On Error GoTo 0
If Not rng Is Nothing Then
Application.ScreenUpdating = False
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
sFile = "TestKopie_1" 'geschlossene Datei
sPath = ThisWorkbook.Path & "\" 'im gleichen Ordner wie aktuelle, geöffnete Datei
Application.StatusBar = "Daten werden importiert. Bitte warten..."
With rng
.Formula = "='" & sPath & "[" & sFile & "]Tabelle1'!A1"
.Value = .Value
End With
End If
With Application
.ScreenUpdating = True
.StatusBar = False
.DisplayStatusBar = oldStatusBar
End With
End Sub
Gruß
Rudi
Anzeige
AW: Danke Rudi, das geht schon, aber ...
16.02.2021 15:37:52
Dieter(Drummer)
... im Code muss ich noch den Bereich, der kopiert werden soll angeben.
Dann wähle ich die über die Inputbox die Startzeile zum einfügen an und dann wird alles eingefügt.
Das klappt.
Ein Wunsch wäre noch, wenn der zu kopierende Bereich auch per Inputbox gewählt werden könnte.
Ich hoffe, das ist nicht unverschämt von mir.
Gruß, Dieter(Drummer)
AW: Danke Rudi, das geht schon, aber ...
16.02.2021 16:42:28
Daniel
Hi
damit Rudi nicht soviel für dich arbeiten muss hab ich das mal eingebaut.
ist allerdings nicht getestet
Sub AuslesenGeschlDatei()
Dim sFile As String, sPath As String
Dim rngZiel As Range
Dim strQuelle As String
Dim rngQuelle As Range
strQuelle = InputBox("Adresse Quellbereich eingeben")
On Error Resume Next
Set rngQuelle = ActiveSheet.Range(strQuelle)
Set rngZiel = Application.InputBox("Zielereich auswählen:", "Bereichsauswahl", , , , , , 8)
On Error GoTo 0
If rngZiel Is Nothing Or rngQuelle Is Nothing Then
MsgBox "Abbruch oder ungültige Eingabe.", vbCritical
Else
Set rngZiel = rngZiel.Resize(rngQuelle.Rows.Count, rngQuelle.Columns.Count)
sFile = "TestKopie_1" 'geschlossene Datei
sPath = ThisWorkbook.Path & "\" 'im gleichen Ordner wie aktuelle, geöffnete Datei
With rngZiel
.Formula = "='" & sPath & "[" & sFile & "]Tabelle1'!" & rngQuelle(1).Address(0, 0)
.Value = .Value
End With
End If
End Sub
ScreenUpadting und Statusbar hab ich rausgenommen.
das sollte hier nicht benötigt werden (es sei denn, du überträgst riesen Zellbereiche)
Gruß Daniel
Anzeige
AW: Danke Daniel, klappt perfekt, und ...
16.02.2021 16:56:17
Dieter(Drummer)
... es sind keine Riesenbereiche, die kopiert werden.
Danke dir und natürlich auch Rudi, für tolle Lösung.
Gruß, Dieter(Drummer)
AW: Geht auch eine Variante, wenn ...
17.02.2021 08:50:35
Dieter(Drummer)
Guten Morgen Daniel,
Danke nochmal für deine gestrige, funktionierende Lösung.
Hoffe meine jetzige Frage ist nicht zu unverschämt.
Hättest Die auch eine Lösung, wenn per Input auch ein anderer Ordner angegeben werden kann, in dem die Datei der zu kopierenden Daten ist? Wird kein anderer Ordner gewählt, dann soll es dabei belieben, dass beide Dateien im selben Ordner sind.
Wäre toll, wenn Du dafür auch eine Lösung hättest.
Mit Gruß, Dieter(Drummer)
Hier meine jetziger, von dir zuletzt angepasster Code:
''In diesem Beispiel bleibt die Quell-Mappe geschlossen.
'In diesem Beispiel liegen Quell- und Zielmappe im gleichen Verzeichnis.
'Anpassung einzufügender Bereich. Herber: von Rudi Maintaire am 16.02.2021 14:42:07
'Anpassung von: Herber, von Daniel am 16.02.2021 16:42:28
Sub AuslesenGeschlDatei_3()
Dim sFile As String, sPath As String
Dim rngZiel As Range
Dim strQuelle As String
Dim rngQuelle As Range
strQuelle = InputBox("Quellbereich eingeben:", "Kopierbereich") 'zu kopierender Bereich
On Error Resume Next
Set rngQuelle = ActiveSheet.Range(strQuelle)
Set rngZiel = Application.InputBox("Zielereich auswählen:", "Bereichsauswahl", , , , , , 8)
On Error GoTo 0
If rngZiel Is Nothing Or rngQuelle Is Nothing Then
MsgBox "Abbruch oder ungültige Eingabe.", vbCritical
Else
Set rngZiel = rngZiel.Resize(rngQuelle.Rows.Count, rngQuelle.Columns.Count)
sFile = "TestKopie_1" 'Quelle: geschlossene Datei
sPath = ThisWorkbook.Path & "\" 'im gleichen Ordner wie aktuelle, geöffnete Datei
With rngZiel
.Formula = "='" & sPath & "[" & sFile & "]Tabelle1'!" & rngQuelle(1).Address(0, 0)
.Value = .Value
End With
End If
End Sub

Anzeige
AW: Geht auch eine Variante, wenn ...
17.02.2021 10:49:23
Rudi
hallo, 
Sub AuslesenGeschlDatei()
Dim sFile As String, sPath As String
Dim rngZiel As Range
Dim strQuelle As String
Dim rngQuelle As Range
strQuelle = InputBox("Adresse Quellbereich eingeben")
On Error Resume Next
Set rngQuelle = ActiveSheet.Range(strQuelle)
Set rngZiel = Application.InputBox("Zielereich auswählen:", "Bereichsauswahl", , , , , ,  _
8)
On Error GoTo 0
If rngZiel Is Nothing Or rngQuelle Is Nothing Then
MsgBox "Abbruch oder ungültige Eingabe.", vbCritical
Else
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
sPath = .SelectedItems(1)
Else
sPath = ThisWorkbook.Path
End If
End With
sPath = sPath & "\"
Set rngZiel = rngZiel.Resize(rngQuelle.Rows.Count, rngQuelle.Columns.Count)
sFile = "TestKopie_1" 'geschlossene Datei
With rngZiel
.Formula = "='" & sPath & "[" & sFile & "]Tabelle1'!" & rngQuelle(1).Address(0, 0)
.Value = .Value
End With
End If
End Sub

Gruß
Rudi
Anzeige
AW: Danke Rudi, es kommt aber ein Fehler ...
17.02.2021 11:34:20
Dieter(Drummer)
Hallo Rudi,
herzlichen Dank für deine neue Hilfe.
Es kommt aber ein Fehler, bei der ersten Eingabe: z.B. C:\Test\ oder auch C:\Test.
Fehler: Laufzeitfehler 1004, Objekt- oder Objektdefinierter Fehler.
Ist meine Eingabe falsch?
Gruß, Dieter(Drummer)
AW: Danke Rudi, es kommt aber ein Fehler ...
17.02.2021 13:21:11
Rudi
Hallo,
du missverstehst das.
1. nur den Quellbereich angeben (A1:F20 oder so)
2. den Zielbereich angeben.
Wenn beide korrekt sind, wird ein Dialog zur Auswahl des Pfads geöffnet: 
        With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
sPath = .SelectedItems(1)
Else
sPath = ThisWorkbook.Path
End If
End With

Wenn du hier auf Abbrechen klickst wird der Ordner deiner Datei genommen (If .Show =-1 ....)
Gruß
Rudi
Anzeige
AW: Danke Rudi, jetzt gehts ...
17.02.2021 14:14:20
Dieter(Drummer)
Hallo Rudi,
herzlchen Dank für die funktionierende Variante und deine Erklärung.
Gruß und allen Spezialsten-/innen einen erfreulichen Tag.
Dieter(Drummer)
AW: Habe Code etwas erweitert ..
18.02.2021 11:21:41
Dieter(Drummer)
Sorry, hatte diese Mitteilung versehentlich neu angegeben.
Guten Tag Rudi,
... habe eine MsgBox mit Anwendungshinweisen zugefügt und zusätzlich eine Sprachausgabe mit Handling Hinweisen. Wärend der Sprachausgabe kann dennoch direkt weiter gearbeitet werden. Evtl. haben noch andere dafür Verwendung.
Danke nochmal für deine Variante und natürlich auch die Varianten der anderen Spezialsten.
Gruß, Dieter(Drummer)
Hier der jetzige Code:
''In diesem Beispiel bleibt die Quell-Mappe geschlossen.
'In diesem Beispiel liegen Quell- und Zielmappe im gleichen Verzeichnis.
'Anpassung einzufügender Bereich. Herber: von Rudi Maintaire am 16.02.2021 14:42:07
'Variante 4. Herber: von Rudi Maintaire am 17.02.2021 10:49:23 und am 17.02.2021 13:21:11
Sub AuslesenGeschlDatei_4()
Dim sFile As String, sPath As String
Dim rngZiel As Range
Dim strQuelle As String
Dim rngQuelle As Range
Application.Speech.Speak ("Achtung: In der erste Inputbox den Kopierbereich eingeben, z.B. A3:  _
_
A5, In zweiter Inputbox Startzelle eingeben oder in aktueller Datei anklicken. Nach OK kann  _
optional derb Ordner, der Qelldaten enthält, ausgewählt werden, oder Abbrechen wählen, dann werden Daten aus dem Ordner gewählt, der Quell- und aktuellen Datei enhält"), SpeakAsync:=True
MsgBox "Handling:" & vbLf & vbLf & "In 1. Inputbox Kopierbereich eingeben, z.B. A3:A5" &  _
vbLf & _
"in 2. Inputbox Startzelle eingeben oder in aktueller Datei anklicken." & vbLf & vbLf & _
"Nach OK kann optional der Ordner, der Qelldaten enthält," & vbLf & _
"ausgewählt werden, oder Abbrechen wählen. Dann werden Daten" & vbLf & _
"aus dem Ordner gewählt, der Quell- und die aktuellen Datei enhält.", 64, "Hinweis"
strQuelle = InputBox("Adresse: Quellbereich (Zellbereich) eingeben")
On Error Resume Next
Set rngQuelle = ActiveSheet.Range(strQuelle)
Set rngZiel = Application.InputBox("Zielereich auswählen:", "Bereichsauswahl", , , , , ,   _
_
8)
On Error GoTo 0
If rngZiel Is Nothing Or rngQuelle Is Nothing Then
MsgBox "Abbruch oder ungültige Eingabe.", vbCritical
Else
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
sPath = .SelectedItems(1)
Else
sPath = ThisWorkbook.Path
End If
End With
sPath = sPath & "\"
Set rngZiel = rngZiel.Resize(rngQuelle.Rows.Count, rngQuelle.Columns.Count)
sFile = "TestKopie_1" 'geschlossene Datei
With rngZiel
.Formula = "='" & sPath & "[" & sFile & "]Tabelle1'!" & rngQuelle(1).Address(0, 0)
.Value = .Value
End With
End If
End Sub

Anzeige
AW: Bessere Erklärung und Wunsch ...
16.02.2021 16:23:51
Dieter(Drummer)
Hallo Rudi,
falls Du noch etwas anpassen kannst, hätte ich diesen Wunsch:
1) Den zu kopierenden Bereich, aus der nicht offenen Datei, per Inputbox angeben.
2) Den Einfügebereich per Inputbox nur mit Startzelle angeben.
Wäre toll, wenn Du das noch anpassen könntest. Ich kann aber auch verstehen, wenn Du genug bisher daran getan hast.
Gruß, Dieter(Drummer)

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