Sub Schaltfläche2_Klicken()
Dim z, i, Anzahl As Integer
Dim zeilen As Integer
Dim spalten As Integer
Dim Dateiname As String
Dim Ausgabedatei As String
Dim Pfad As String
Dim Datei As String
Dim Adresse As Variant
Dim Pos As Long
Dim Count As Integer
Dim SelectedFiles As Integer
Dim OLZelle As String
Dim OLSpalte As String
Dim OLZeile As String
Dim startzeile As Integer
Dim Kostenstelle As String
Dim Tabellenblatt As String
Dim Detailbereich As String
Dim Detail As Integer
Dim oTargetBook As Object
Dim oSourceBook As Object
Dim Bereiche As Integer
Dim dat
Dim bolOeffnen As Boolean
Set dat = Application.FileDialog(msoFileDialogFilePicker)
With dat
.Title = "Statistikdaten"
.InitialFileName = "\\ServerQuelldaten\reports"
.AllowMultiSelect = False
bolOeffnen = .Show
If bolOeffnen = True Then
SelectedFiles = .SelectedItems.Count
Dateiname = .SelectedItems(1)
Else:
MsgBox "Abbruch durch Benutzer.", vbInformation
End If
End With
If SelectedFiles > 0 Then
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set oTargetBook = ActiveWorkbook
Set oSourceBook = Workbooks.Open(Dateiname, False, True)
oTargetBook.Sheets("Export").Cells.Clear
startzeile = 1
Bereiche = ActiveWorkbook.Names.Count
Bereiche = oSourceBook.Names.Count
For Linie = 1 To 4
Select Case Linie
Case 1
Tabellenblatt = "Linie1a"
Detailbereich = "DetailsTable2"
Kostenstelle = "005"
Case 2
Tabellenblatt = "Linie2"
Detailbereich = "DetailsTable3"
Kostenstelle = "006"
Case 3
Tabellenblatt = "Linie3"
Detailbereich = "DetailsTable4"
Kostenstelle = "007"
Case 4
Tabellenblatt = "Linie4"
Detailbereich = "DetailsTable5"
Kostenstelle = "011"
End Select
Sheets(Tabellenblatt).Select
Range(Detailbereich).Select
zeilen = Range(Detailbereich).Rows.Count
If zeilen > 0 Then
spalten = Range(Detailbereich).Columns.Count
Adresse = Range(Detailbereich).Address
Pos = InStr(1, Adresse, ":")
OLSpalte = WorksheetFunction.Substitute(Left(Adresse, InStr(2, Adresse, "$") - 1), "$", "")
OLZeile = WorksheetFunction.Substitute(Mid(Adresse, InStr(2, Adresse, "$") + 1, Pos - InStr(2, Adresse, "$") - 1), "$", "")
For i = 1 To zeilen
oTargetBook.Sheets("Export").Cells(startzeile + i - 1, 1).Value = oSourceBook.Sheets(Tabellenblatt).Cells(OLZeile + i - 1, Columns(OLSpalte).Column + 6).Value
oTargetBook.Sheets("Export").Cells(startzeile + i - 1, 2).Value = oSourceBook.Sheets(Tabellenblatt).Cells(OLZeile + i - 1, Columns(OLSpalte).Column + 8).Value
oTargetBook.Sheets("Export").Cells(startzeile + i - 1, 3).Value = oSourceBook.Sheets(Tabellenblatt).Cells(OLZeile + i - 1, Columns(OLSpalte).Column + 11).Value
oTargetBook.Sheets("Export").Cells(startzeile + i - 1, 4).Value = Kostenstelle
Next
End If
startzeile = startzeile + zeilen
Next
oSourceBook.Close savechanges:=False
Ausgabedatei = "\\ServerZieldaten\Ablage\Statistik_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".txt"
Open Ausgabedatei For Output As #1
For i = 1 To oTargetBook.Sheets("Export").UsedRange.Rows.Count
Print #1, oTargetBook.Sheets("Export").Cells(i, 1).Value & vbTab & oTargetBook.Sheets("Export").Cells(i, 2).Value & vbTab & _
oTargetBook.Sheets("Export").Cells(i, 3).Value & vbTab & oTargetBook.Sheets("Export").Cells(i, 4).Value
Next
Close #1
MsgBox (Ausgabedatei & " wurde erstellt")
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
End Sub