Blatt Inhalt kopieren

Hallo zusammen,
ich habe jetzt einige Seiten durchsucht und auch shcon ein paar Lösungen probiert aber keine funktioniert bis jetzt.
Mein Problem/Aufgabe ist Ein Excel Makro zu erstellen, das zunächst einen Datei öffnen Dialog aufruft und dann aus der ausgewählten Datei den Inhalt des ersten Blattes in das Blatt "Import" des Excel files mit dem Makro schreibt.
Also in einfachen schritten:
-Excel Datei "A" öffnen
-Makro ausführen
-Excel Datei "B" auswählen
-Makro kopiert Inhalt von Blatt 1 aus Datei B
-In Blatt 2 ("Import") von Datei A
-Datei B wird geschlossen
Also im Grunde ein recht einfacher Import sollte man meinen. Die konkreten Schritte sind dabie nicht so wichtig, also gerne ohne öffnen und schließen, Hauptsache die Daten kommen von B nach A ^^.
Bis jetzt klappt auch schon das auswählen und öffnen der Datei:
Public Sub Import()
Dim VarDateiPfad As Variant
Dim Source As Workbook
Dim FilterDestination As Workbook
'Legt Standard Verzeichnis des "Datei öffnen" Dialogs fest.
ChDrive ("X:\") 'hier Laufwerk angeben
ChDir ("X:\X....") ' hier exakten Pfad angeben
'Startet "Import" Dialog und legt ausgewählte Datei in "VarDateiPfad" ab
VarDateiPfad = Application.GetOpenFilename("Exceldateien,*.xls*", 1)
Alles soweit so gut denke ich. Vom folgenden funktioniert aber wohl nur die erste Zeile (ausgewählte Excel öffnet sich aber es ist nichts in der Zwischenablage und es wird auch nichts kopiert):
Workbooks.Open Filename:=VarDateiPfad, ReadOnly:=False
ActiveWorkbook.Sheets("X").UsedRange.Copy
ThisWorkbook.Sheets("Import").PasteSpecial xlValues
ActiveWorkbook.Close
Ich hoffe ihr könnt mir helfen.
Danke schonmal.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Import() wb = Application.GetOpenFilename("Excel-Dateien, *.xlsx") If wb = False Then MsgBox "Keine Datei ausgewählt. Das Makro wird beendet." Exit Sub End If Set wb_ziel = ThisWorkbook Set ws_ziel = wb_ziel.Sheets(Sheets.Count) Set wb_roh = Workbooks.Open(wb, ReadOnly:=True) Set ws_roh = wb_roh.Sheets(2) For Each ws In wb_ziel.Worksheets If ws.Name = "Import" Then Application.DisplayAlerts = False ws.Delete Application.DisplayAlerts = True End If Next ws With wb_roh ws_roh.Copy After:=ws_ziel .Close False End With Set ws_roh = Nothing Set ws_ziel = Nothing Set wb_roh = Nothing Set wb_ziel = Nothing End Sub

Vielen DAnk schonmal für die Hilfe :)
Leider klappt Torstens Lösung
Workbooks.Open Filename:=VarDateiPfad, ReadOnly:=False
ActiveWorkbook.Sheets("X").UsedRange.Copy
ThisWorkbook.Sheets("Import").Range("A1").PasteSpecial xlValues
ActiveWorkbook.Close
nicht. Das Fehlerbild bleibt identisch. Ausgewählte Datei öffnet sich und das wars.
Schade, sieht eig. nach iener super Lösung aus :/
@Bernd
Das "Import Blatt wird vorher (clear) gelöscht also ist komplett leer. Die Formattierung kann übernommen werden aber eignetlich gibt es keine, also nicht relevant.
Das Blatt "Import" kann auch just in Time erst angelegt werden oder das neue Blatt rüberkopiert werden.
Wichtig ist wie gesag nur das die Info von A nach B kommt ^^

Const strFile As String = "C:\xxx\xxx.xlsm" ' Pfad und Datei Const strSheetQ As String = "Tabelle1" ' DIE Tabelle wird ausgelesen" Const strSheetZ As String = "Import" ' Die Tabelle in DIESER Datei Const strRange As String = "F5:F30" ' Der Bereich wird ausgelesen Public Sub Main() With ThisWorkbook.Worksheets(strSheetZ) .UsedRange.ClearContents .Range("F5:F30").Formula = "='" & Mid(strFile, 1, _ InStrRev(strFile, "\")) & "[" & Mid(strFile, InStrRev(strFile, _ "\") + 1) & "]" & strSheetQ & "'!" & strRange End With End Sub

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread