Hilfe.. ich verzweifel :(
27.08.2014 18:25:49
Crini
ich bin ein kompletter VBA-Neuling, benötige aber ein Makro, welches mir Inhalte aus mehreren Dateien (entweder aus einer Excel oder einer Word-Datei) kopiert und in eine "Übersichtsdatei" nacheinander zusammenfügt.
Es gibt also ca. 26 komplett gleich aufgebaute Excel-Dateien (beinhaltet ca. 50 Zeilen und 5 Spalten, wobei die Werte nur aus den Spalten 3-5 importiert werden sollen und die Zeilenanzahl variieren kann).
Die von unterschiedlichen Personen ausgefüllte Datei (Spalte A + B bleiben gleich, es wird nur Spalte C, D und E ausgefüllt) wird mir per Mail zugeschickt und ich speichere diese in einem bestimmten Ordner ab.
Ich möchte nun eine Datei erstellen, die mir auf Knopfdruck die Inhalte der 1. Zeile Spalte C, D und E aller Personen in die Spalte C, D und E untereinander schreibt. Anschließend sollen alle Inhalte der 2. Zeile aufgeführt werden usw.
Ich habe im Internet bereits folgendes Makro gefunden, welches meinem Ziel sehr nahe kommt:
Sub Import_Aufgabenbereich()
Dim objDocument As Object
Dim strDatei As String
Dim strPfad As String
Dim objApp As Object
On Error GoTo Fin
' Pfad anpassen
strPfad = "H:\Ordner\"
Set objApp = OffApp("Word")
' Word nicht sichtbar
'Set objApp = OffApp("Word", False)
If Not objApp Is Nothing Then
Columns(10).Clear
strDatei = Dir$(strPfad & "*.doc*", vbDirectory)
Do While strDatei ""
Set objDocument = objApp.Documents.Open _
(strPfad & strDatei)
Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
Replace(objDocument.Tables(1).Cell(2, 3).Range, _
Chr(13) & Chr(7), "")
Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
Replace(objDocument.Tables(1).Cell(2, 4).Range, _
Chr(13) & Chr(7), "")
Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
Replace(objDocument.Tables(1).Cell(2, 5).Range, _
Chr(13) & Chr(7), "")
objDocument.Close False
strDatei = Dir$()
Loop
Else
MsgBox "Applikation nicht installiert!"
End If
Fin:
If Not objApp Is Nothing Then
If blnTMP = True Then
objApp.Quit
blnTMP = False
End If
End If
Set objApp = Nothing
If Err.Number 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub
Problem ist, dass ich nicht nur die eine Zelle der Spalte C (2,3), D (2,4), E (2,5) aus den jeweiligen Dateien benötige, sondern alle.. Das wird doch irgendwie mit einer Schleife (?) gehen oder?
Habe im Moment eine Lösung, indem ich das Makro 30 mal wiederhole und beim 2. Makro Spalte c (3,3), D (3,4), E (3,5), beim 3. Makro Spalte c (4,3), D (4,4), E (4,5), anwähle usw. und dann ein Start-Makro, welches alle 30 Makros hintereinander abspielt, dies ist jedoch sehr umständlich.
Zusätzlich habe ich das Problem, dass mir in der Übersichtsdatei leere Zeilen nicht eingefügt werden. Das bedeutet, dass wenn z.B. bei einer eingehenden Datei Zelle E1 leer ist (was häufig vorkommt), die Inhalte der nächsten Datei aus E1 in die Übersichtstabelle in die jeweilige Zeile der Spalte E eingefügt wird, anstatt die Zelle auch leer zu lassen. So passt die 3. Spalte nicht mehr zur 1., wenn ihr versteht, was ich meine? Es ist schwierig das zu formulieren ohne Kenntnisse.. :-( Vielleicht kann mir jemand helfen?
Vielen lieben Dank im Voraus!!
ich habe hier zwei Beispieldateien, wie sie bei mir eintreffen:
https://www.herber.de/bbs/user/92331.doc
https://www.herber.de/bbs/user/92332.doc
wenn man diese in einem Ordner abspeichert und den Pfad im Makro abändert, so kann man hoffentlich sehen, wo mein Problem liegt..