20.02.2017, 09:40
Hallo!
Ich hoffe Ihr könnt mir weiterhelfen. Ich stehe vor einem kleinen großen Problem.
Ich habe eine "Masterdatei", in der eine Tabelle ist. Von B1-B9 bis X1-X9 eine Statistik, von B10-12 die Überschrift ist und ab B12 die Spaltenbezeichnung für die Tabelle anfängt. Diese Spaltenbezeichnungen der Tabellen geht bis W12.
Also würde es ungefähr so aussehen: (kleineres Format)
Mitarbeiter
Vorname Nachname Alter Anrede
Und da drunter würden dann die Daten stehen.
Nun werde ich diese Masterdatei wegschicken und ausgefüllt zurückbekommen. Ungefähr 50 einzelne Dateien.
Nun wollte ich dies automatisieren, damit die einzelnen Dateien, in der Masterdatei zusammenkommen und die Tabelle erweitern.
Nun habe ich zwei Anläufe mit Makros gestartet.
1.
-> Hier liegt das Problem, dass ich die einzelnen Dateien, in der Masterdatei als Tabelle hinzufügen muss. Dazu kopiert er hier auch die Statistiken mit, was ich ja nicht möchte.
2.
-> Bei diesem hier wiederum, kann ich die einzelnen Dateien auswählen. Aber hier kopiert er wieder die Statistiken mit und füllt bei leeren Zeilen eine "0" aus. Wobei er bei den Statistiken die Formatierung auch nicht übernimmt.
Ich hoffe ich konnte mich klar ausdrücken, falls noch Fragen anstehen, stehe ich gerne zur Verfügung.
Vielen Dank für Eure Hilfe!
LG
Ich hoffe Ihr könnt mir weiterhelfen. Ich stehe vor einem kleinen großen Problem.
Ich habe eine "Masterdatei", in der eine Tabelle ist. Von B1-B9 bis X1-X9 eine Statistik, von B10-12 die Überschrift ist und ab B12 die Spaltenbezeichnung für die Tabelle anfängt. Diese Spaltenbezeichnungen der Tabellen geht bis W12.
Also würde es ungefähr so aussehen: (kleineres Format)
Mitarbeiter
Vorname Nachname Alter Anrede
Und da drunter würden dann die Daten stehen.
Nun werde ich diese Masterdatei wegschicken und ausgefüllt zurückbekommen. Ungefähr 50 einzelne Dateien.
Nun wollte ich dies automatisieren, damit die einzelnen Dateien, in der Masterdatei zusammenkommen und die Tabelle erweitern.
Nun habe ich zwei Anläufe mit Makros gestartet.
1.
Code:
Sub TabellenKopieren()
Dim i As Integer
With ActiveWorkbook
'neue Tabelle an die erste Position einfügen
.Worksheets.Add Before:=.Worksheets(1)
For i = 2 To .Worksheets.Count
'Ermitteln den benutzen Bereich der einzelnen Tabellenblätter
Set Rng = .Worksheets(i).UsedRange
'letzte Zeile ermitteln des ersten Blattes
Set rng1 = Worksheets(1).Cells(Rows.Count, "A").End(xlUp)(2)
'Bereich kopieren
Rng.Copy Destination:=rng1
Next
End With
End Sub-> Hier liegt das Problem, dass ich die einzelnen Dateien, in der Masterdatei als Tabelle hinzufügen muss. Dazu kopiert er hier auch die Statistiken mit, was ich ja nicht möchte.
2.
Code:
Sub Zusammenführen()
Dim i As Long
Dim sPfad As String
Dim sDatei As String
Dim vFileToOpen As Variant
Dim lngLZ As Long
Dim blnÜberschrift As Boolean
Dim iCalc As Integer
vFileToOpen = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , , , True)
If Not IsArray(vFileToOpen) Then Exit Sub
iCalc = Application.Calculation
On Error GoTo ENDE:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
For i = 1 To UBound(vFileToOpen)
sDatei = Dir(vFileToOpen(i))
sPfad = Left(vFileToOpen(i), InStr(vFileToOpen(i), sDatei) - 1)
With Tabelle1.Range("A1")
.Formula = "=LOOKUP(2,1/('" & sPfad & "[" & sDatei & "]Tabelle1'!$A:$A<>""""),ROW('" & sPfad & "\[" & sDatei & "]Tabelle1'!$A:$A))"
lngLZ = .Value
End With
With Tabelle1
If blnÜberschrift Then
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lngLZ - 1, 15).Formula = _
"='" & sPfad & "[" & sDatei & "]Tabelle1'!A2"
Else
blnÜberschrift = True
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lngLZ, 15).Formula = _
"='" & sPfad & "[" & sDatei & "]Tabelle1'!A1"
End If
End With
Call StatusBalken(Int((i / UBound(vFileToOpen)) * 100))
Next
With Tabelle1.UsedRange
.Copy
.PasteSpecial xlPasteValues
.Rows(1).Delete
End With
ENDE:
Application.EnableEvents = True
Application.Calculation = iCalc
Application.ScreenUpdating = True
If Err Then MsgBox Err.Description, , "Fehler: " & Err
End Sub
Sub StatusBalken(ProzentSatz) ''ProzentSatz = Int((i / 10000) * 100)
Dim Mess, Z, Rest
Static oldStatusBar As Integer
Static blnInit As Boolean
If Not blnInit Then
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
End If
Mess = ""
For Z = 1 To ProzentSatz
Mess = Mess & ChrW(Val("&H25A0"))
Next Z
Rest = 100 - ProzentSatz
For Z = 1 To Rest
Mess = Mess & ChrW(Val("&H25A1"))
Next Z
Application.StatusBar = Mess & " " & ProzentSatz & "%"
If Rest <= 0 Then
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
End If
End Sub-> Bei diesem hier wiederum, kann ich die einzelnen Dateien auswählen. Aber hier kopiert er wieder die Statistiken mit und füllt bei leeren Zeilen eine "0" aus. Wobei er bei den Statistiken die Formatierung auch nicht übernimmt.
Ich hoffe ich konnte mich klar ausdrücken, falls noch Fragen anstehen, stehe ich gerne zur Verfügung.
Vielen Dank für Eure Hilfe!
LG