Fehler beim Import (kopieren & einfügen) eines Zellbereichs
08.03.2024 13:50:54
Ken871505
Ich möchte mit meinem VBA einen Zellbereich aus einem Excel-Workbook importieren, damit ich die Daten bearbeiten und anschließend in eine neue Datei exportieren kann. Beim Import der Daten in meine VBA-Datei ist ein Fehler aufgetreten, den ich bis jetzt noch nie gesehen habe.
Die Methode Import_Data() öffnet die gewünschte Datei, kopiert den Zellbereich in der Datei und fügt ihn zur weiteren Bearbeitung in die VBA-Datei ein.
Ich habe den Code mit einer eigens erstellten Test-Datei getestet, damit funktioniert alles.
Wenn ich den Code allerdings mit der Originaldatei ausführe, werden nur folgende Zellen in der VBA-Datei angezeigt.
"
A6
1.49.0.0
Stock
A8
Item
Sandvik.SmartSupply.Stock.Administration.ImportExport.ImportExportItem, Sandvik.SmartSupply.Stock, Version=1.49.0.0, Culture=neutral, PublicKeyToken=null
Spalte1#Column1#False#False#;Spalte2#Column2#False#False#; ...
"
die letzte Zeile enthält die Spaltenüberschriften des zu importierenden Zellbereichs.
Hier der Code dazu:
Public FileToOpen As Variant
Public OpenBook As Workbook
Public MeineTabelle As ListObject
Sub Import_Data()
Application.ScreenUpdating = False
'FileToOpen ist der Dateipfad, der zu importierenden Datei
FileToOpen = Application.GetOpenFilename(Title:="Datei importieren")
'Wenn Datei ausgewählt ist, dann...
If FileToOpen > False Then
'Application.DisplayAlerts = False
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Unprotect
Dim DataToCopy As Range
Set DataToCopy = OpenBook.Sheets(1).UsedRange
'Application.CutCopyMode = False
DataToCopy.Copy
ThisWorkbook.Worksheets("Maschinendaten").Range("A10").PasteSpecial xlPasteValues
'ThisWorkbook.Worksheets("Maschinendaten").Range("A10").End(xlToRight).End(xlDown)
OpenBook.Protect
'Tabelle formatieren
Dim AktuellerBereich As Range
Set AktuellerBereich = ThisWorkbook.Worksheets("Maschinendaten").Range("A10").CurrentRegion
'Den aktuell ausgewählten Bereich als Tabelle formatieren
'Application.CutCopyMode = False
'ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = "Item__3"
Set MeineTabelle = ThisWorkbook.Worksheets("Maschinendaten").ListObjects.Add(xlSrcRange, AktuellerBereich, , xlYes)
MeineTabelle.Name = "Item__3"
OpenBook.Close False
Application.DisplayAlerts = True
End If
Application.ScreenUpdating = True
End Sub
Der Fehler müsste meines Wissens nach entweder in der Zeile "Set DataToCopy = OpenBook.Sheets(1).UsedRange" liegen.
Oder (wahrscheinlicher) die Originaldatei lässt sich aus einem Grund, der mir unbekannt ist, nicht richtig importieren.
Ist jemandem von Euch ein solcher Fehler bekannt und könnt mir helfen?
Ich bin für jede Hilfe dankbar.
Viele Grüße
Ken