07.11.2018, 17:25
Hallo Zusammen,
ich stehe mal wieder vor einen kleinen Problem. Ich möchte gern Daten aus einer geschlossenen Arbeitsmappe (sogar bestimmten Arbeotsblatt) einen gewissen Bereich in eine andere Arbeitsmappe importieren. Im Netz habe ich folgenden Code gefunden, der auch super funktioniert
Einziges Problem ist jetzt, dass er mir aus der alten Arbeitsmappe bei den Formeln den Dateipfad mit übernimmt und sich somit die Formeln nicht mehr auf die neue Arbeitsmappe beziehen, sondern auf die alte Arbeitsmappe. Wie kann ich das unterbinden bzw. wäre es einfacher diese eine Splte (F) einfach nicht zu kopieren? Ich wäre euch für jegliche Hilfe super Dankbar.
Ganz lieben Dank
Chris
ich stehe mal wieder vor einen kleinen Problem. Ich möchte gern Daten aus einer geschlossenen Arbeitsmappe (sogar bestimmten Arbeotsblatt) einen gewissen Bereich in eine andere Arbeitsmappe importieren. Im Netz habe ich folgenden Code gefunden, der auch super funktioniert
Code:
Sub Import_Rohdaten()
Application.ScreenUpdating = False ' Screenupdating ausschalten
If MsgBox("Bitte prüfen Sie vor dem Beginn der Daten-Imports, dass in der Rohdaten-Datei" _
& Chr(10) & _
"nur eine Tabelle mit dem Namen vorhanden ist." _
& Chr(10) _
& Chr(10) _
& Chr(10) & _
"Möchten Sie mit dem Import fortfahren?", vbYesNo, "Import Rohdaten") = vbYes Then
Worksheets("Lagerbestand").Select
Range("D1").Select
Call ImportiereRohdaten
Else
Worksheets("Log").Range("b3").Value = Date & " - " & Time & " - Daten-Import abgebrochen."
Worksheets("Log").Select
End If
Application.ScreenUpdating = True ' Screenupdating einschalten
End Sub
Private Sub ImportiereRohdaten()
Application.ScreenUpdating = False ' Screenupdating ausschalten
Dim strArbeitsmappe_Pfad As String
Dim strArbeitsmappe_Name As String
Dim strArbeitsmappe_Tabellenblatt As String
Dim strArbeitsmappe As String
Dim strVerzeichnis As String
Dim StrDatei As String
Dim I As Integer
Dim StrTyp As String
Dim Dateiname As String
Dim Dateiname_neu As String
Dim Zeit As Date
Dim strQuelle_Workbook As String
' Definiert den Pfad der geöffneten Arbeitsmappe (= Zielarbeitsmappe)
' Der Pfad der geöffneten Arbeitsmappe (= Zielarbeitsmappe) wird jedesmal neu ermittelt.
strArbeitsmappe_Pfad = ThisWorkbook.Path & ""
' Definiert den Datei-Namen der geöffneten Arbeitsmappe (= Zielarbeitsmappe)
' Der Name wird jedesmal neu ermittelt.
strArbeitsmappe_Name = ThisWorkbook.Name
' Definiert das Tabellenblatt in der geöffneten Arbeitsmappe (= Zielarbeitsmappe), in das die Rohdaten importiert werden
' Der Name des Tabellenblatts wird jedesmal neu ermittelt.
' ACHTUNG: Der Cursor muss sich zwingend in der Tabelle befinden
strArbeitsmappe_Tabellenblatt = ActiveSheet.Name ' Ziel-Tabellenblatt
' Definiert den Quellpfad der die Arbeitsmappe mit Rohdaten (= Quelle) enthält
strVerzeichnis = ThisWorkbook.Path & "\Export\"
' Definiert den Datei-Typ, der die Rohdaten (= Quelle enthält
StrTyp = "*.xlsx"
Dateiname = Dir(strVerzeichnis & StrTyp)
Dateiname_neu = Dateiname
Zeit = FileDateTime(strVerzeichnis & Dateiname)
' Definiert den Namen der Arbeitsmappe, die die Rohdaten (= Quelle enthält
strQuelle_Workbook = strVerzeichnis & Dateiname_neu ' neu
' Aktiviert die Ziel-Tabelle
Worksheets(strArbeitsmappe_Tabellenblatt).Activate
Range("D1").Activate
' Sucht im Quell-Verzeichnis nach der neuesten Excel-Arbeitsmappe
Do While Dateiname <> ""
If Zeit < FileDateTime(strVerzeichnis & Dateiname) Then
Zeit = FileDateTime(strVerzeichnis & Dateiname)
Dateiname_neu = Dateiname
End If
Dateiname = Dir
Loop
If MsgBox("Es wurde die Datei - " & Dateiname_neu & " - für den Import ausgewählt." & _
Chr(10) & _
Chr(10) & _
"Möchten Sie die Daten importieren?", vbYesNo, "Import Rohdaten") = vbYes Then
' Öffnet die Arbeitsmappe mit den Rohdaten (= Quelle)
Workbooks.Open (ThisWorkbook.Path & "\Export\" & Dateiname_neu)
Sheets("Lagerbestand").Activate
ActiveSheet.Unprotect Password:="PW"
' Prüft den Spaltennamen in der Quell-Datei auf Übereinstimmungauf
' Entspricht die Spaltenüberschrift nicht den Vorgaben, wird der Import abgebrochen
If ActiveSheet.Range("D1").Value = "Zustand" Then
'MsgBox ("Spaltename D der Rohdaten entspricht den Vorgaben")
'Bereich kopieren
Range("d2:j500").Copy
' Aktiviert die Zielarbeitsmappe und fügt die kopierten Daten ein
Windows(strArbeitsmappe_Name).Activate
Worksheets(strArbeitsmappe_Tabellenblatt).Activate
Range("D2").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' Wechselt auf die Rohdaten-Datei und schließt diese
Windows(Dateiname_neu).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
' Wechselt zur Zielarbeitsmappe und setzt den Cursor in die Zelle A1
Windows(strArbeitsmappe_Name).Activate
Worksheets(strArbeitsmappe_Tabellenblatt).Activate
Range("E2").Select
' Schreibt in den Log-Bereich in Tabelle "Dashboard"
Worksheets("Log").Range("b3").Value = Date & " - " & Time & " - Daten-Import erfolgreich abgeschlossen."
Worksheets("Log").Select
' Wenn der Spaltenname nicht den Vorgaben entspricht, wird der Import abgebrochen
Else
'MsgBox "Abbruch - Falsche Spaltenbenennung."
' Wechselt auf die Rohdaten-Datei und schließt diese
Windows(Dateiname_neu).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
' Wechselt zur Zielarbeitsmappe und setzt den Cursor in die Zelle A1
Windows(strArbeitsmappe_Name).Activate
Worksheets(strArbeitsmappe_Tabellenblatt).Activate
Range("E2").Select
MsgBox "Daten-Import abgebrochen - Falsche Spaltenbenennung in den Rohdaten. Bitte prüfen Sie das Log-File."
Worksheets("Log").Range("b3").Value = Date & " - " & Time & " - Daten-Import abgebrochen - falsche Spaltenbenennung in den Rohdaten. Spalte C <> Spaltenüberschrift."
Worksheets("Log").Select
End If
Else
MsgBox "Der Import wurde abgebrochen."
Worksheets("Log").Range("b3").Value = Date & " - " & Time & " - Daten-Import abgebrochen."
Worksheets("Log").Select
End If
Application.ScreenUpdating = True ' Screenupdating einschalten
End SubGanz lieben Dank
Chris