AW: Import via Button, Export Datei und Import Datei
19.08.2017 04:58:41
fcs
Hallo Daniel,
man kann die beiden Importe in einer Arbeitsmappe zusammenfassen.
Dazu muss man beim 2. Import "nur" dessen Vorlage-Tabelle aus der Master-Datei in die Datei mit dem 1. Import kopieren.
Um Fehler im Makro-Ablauf zu vermeiden müssen vor dem Kopieren aber ehrere Randbedingungen geprüft werden.
Dafür vereinfacht sich dann das Speichern.
LG
Franz
Sub Schaltflaeche_Import_Nr_2()
Dim strFileName As String
Dim wkbExport As Workbook, wksExport As Worksheet
Dim Zeile_E As Long, Spalte_E As Long, Zeile_EL&, Spalte_EL&
Dim Zeile_I As Long, Spalte_I As Long
Dim datExp As Date, datImp As Date, strDatExp As String
Dim wkbImport As Workbook, wksImport As Worksheet
Dim strDateiImport As String
Set wksImport = _
ThisWorkbook.Worksheets("Import_Sheet_Nr_2") 'Blattname für 2. Vorlage anpassen
With ThisWorkbook.Worksheets("Tabelle1")
strFileName = .Range("B14").Text 'Zelle mit Dateiname für 2. ERP-Datei ggf. anpassen
End With
If Dir(strFileName) = "" Then
MsgBox "ERP-Exportdatei" & vbLf & strFileName & vbLf & "nichtgefunden!", _
vbOKOnly, "Prüfen Name ERP-Export-Datei"
GoTo Beenden
End If
'Name der Datei/Arbeitsmappe des 1. Imports - ggf.anpassen
strDateiImport = "ERP-Import " & Format(Date, "YYYY-MM-DD") & ".xlsx"
'prüfen, ob Mappe mit 1. Import angelegt ist
If Dir("C:\TEMP\export" & Application.PathSeparator _
& strDateiImport) = "" Then
MsgBox "Der Import für die 1. ERP-Exportdatei wurde noch nicht durchgeführt", _
vbOKOnly, "Prüfen ob Datei aus 1. ERP-Import vorhanden"
GoTo Beenden
Else
'prüfen ob Datei geöffnet ist
For Each wkbImport In Application.Workbooks
If LCase(wkbImport.Name) = LCase(strDateiImport) Then
Exit For
End If
Next wkbImport
If wkbImport Is Nothing Then 'Datei st ncht geöffnet
Set wkbImport = Application.Workbooks.Open("C:\TEMP\export" _
& Application.PathSeparator & strDateiImport)
End If
End If
'Import-Vorlage in die Arbeitsmappe vom 1. Import kopieren
With wkbImport
'Prüfen, ob schon mehr als 1 Tabellenblatt in ERP-Import-Datei vorhanden ist.
If .Sheets.Count > 1 Then
If MsgBox("Die Arbeitsmappe enthält bereits ein Blatt mit einem 2. Import" _
& vbLf & "Blatt mit 2. Import ersetzen?", _
vbQuestion + vbOKCancel, _
"Prüfen Anzahl Blätter in ERP-Import-Datei") = vbOK Then
Application.DisplayAlerts = False
.Sheets(2).Delete
Application.DisplayAlerts = True
Else
GoTo Beenden
End If
End If
wksImport.Copy after:=.Sheets(1)
Set wksImport = wkbImport.Sheets(2)
End With
With wksImport
'Blattumbenennen
.Name = "Import Nr 2 " & Format(Date, "YYYY-MM-DD") 'Blatt-Name anpassen für 2. Import!
End With
With Application
.ScreenUpdating = False
End With
'Export-Datei öffnen
Set wkbExport = Application.Workbooks.Open(Filename:=strFileName, ReadOnly:=True)
Set wksExport = wkbExport.Worksheets(1)
'===== ab hier die Anpassungen für den 2. Import ================
'Daten in Export-Tabelle kopieren und als Werte in Import-Blatt einfügen
With wksExport
Zeile_EL = .Cells(.Rows.Count, 1).End(xlUp).Row
Zeile_I = 4
Spalte_I = 1: Spalte_E = 1 'Arbeitsplatz
.Range(.Cells(2, Spalte_E), .Cells(Zeile_EL, Spalte_E)).Copy
wksImport.Cells(Zeile_I, Spalte_I).PasteSpecial Paste:=xlPasteValues
Spalte_I = 2: Spalte_E = 9 'I, J , K Material-Bezeichnung-Abladestelle
.Range(.Cells(2, Spalte_E), .Cells(Zeile_EL, Spalte_E + 2)).Copy
wksImport.Cells(Zeile_I, Spalte_I).PasteSpecial Paste:=xlPasteValues
Spalte_I = 5: Spalte_E = 14 'Dispositiver Bestand
.Range(.Cells(2, Spalte_E), .Cells(Zeile_EL, Spalte_E)).Copy
wksImport.Cells(Zeile_I, Spalte_I).PasteSpecial Paste:=xlPasteValues
Spalte_I = 6: Spalte_E = 17 'Rückstand
.Range(.Cells(2, Spalte_E), .Cells(Zeile_EL, Spalte_E)).Copy
wksImport.Cells(Zeile_I, Spalte_I).PasteSpecial Paste:=xlPasteValues
Spalte_I = 7 'Spalte G
Spalte_E = 19 '1. Spalte in Export-Blatt mit Datum in Zeile 1
'1. zwölf Datumswerte in Zeile 1 im Import-Blatt ab Zelle G1 einfügen
.Range(.Cells(1, Spalte_E), .Cells(1, Spalte_E + 11)).Copy
wksImport.Cells(1, Spalte_I).PasteSpecial Paste:=xlPasteValues
'Datumswerte aufbereiten
wksImport.Range("G1:R1").Replace What:="PBD-", replacement:="", lookat:=xlPart
With wksImport.Range("G3:R3") 'Wohentage
.Calculate
.Value = .Value 'Formeln durch Werte ersetzen
End With
'Werte zu den Tagen kopieren und als Werte einfügen
.Range(.Cells(2, Spalte_E), .Cells(Zeile_EL, Spalte_E + 11)).Copy
wksImport.Cells(Zeile_I, Spalte_I).PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
'Export-Datei wieder schliessen
wkbExport.Close savechanges:=False
Call Sortieren(wks:=wksImport)
Call Teilergebnisse(wks:=wksImport)
Range("C4").Select
'====== Änderung für Speichern der beiden Imports in einer Datei ======
'Import-Datei Speichern
wkbImport.Save
With Application
.ScreenUpdating = True
End With
Beenden:
End Sub