---

Hallo!

habe vor ein paar Tagen dieses Forum hier entdeckt und bin es gefällt mir bisher ganz gut, auch wenn ich in Sachen VBA noch nicht wirklich viel verstehe...

und daher komme ich bei meinem VBA-Problem nicht wirklich weiter...

Im Prinzip ist das was ich vorhabe nicht sonderlich schwierig.. hinbekommen habe ich es aber trotzdem nicht 

Ich will aus verschiedenen xls-Dateien immer die gleichen Zeilenabschnitte kopieren und in eine Zusammenfassende Excel-Tabelle einfügen, für jede datei eine neue Zeile

Ich beschäftige mich jetzt seit gut 2 Wochen mit VBA u hab mich schon am Code probiert, läuft aber nicht 

Code:

---

Sub Test()

strPath = "D:\Users\%User%\Documents\Sollstundenberechnung FAA\Rechner-Liste"
    strExt = "*.xls"
    Dim strFile As String
    If strPath = "" Then
        Exit Sub
    Else
        strFile = Dir(strPath & strExt)
        Do While Len(strFile) > 0
            Workbooks.Open Filename:=strPath & strFile
           
               
            Sheets("Verteilung").Select
                       
                Dim i As Ingeger
                Dim cell As Range
                i = 5
                For Each cell In Verteilung
                'Cluster 2
                          .Range("L83:R83").Select
                          .Range("U91").Select
                          .Range("J5").Select
                'Cluster 5
                          .Range("L196:R196").Select
                          .Range("U204").Select
                          .Range("U206").Select
                ' Cluster 8
                          .Range("L308:R308").Select
                          .Range("U316").Select
                          .Range("U318").Select
                ' Cluster 10
                          .Range("L428:R428").Select
                          .Range("U436").Select
                          .Range("U438").Select
                             
                  cell.EntireRow.Copy
                  Windows("Zeitraumberechung Soll FAA-Std MakroTest2.xlsm").Activate
                  Sheets("Import").Select
                    Range("C(i):AU(i)").Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                  :=False, Transpose:=False
                  i = i + 1
           
                         
        Workbooks(strFile).Close
            strFile = Dir() ' nächste Datei
        Loop
    End If

End Sub
 

---

Wisst ihr vielleicht wie ich das Teil zum laufen bekomme?

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

als erstes würde ich meinen. es müsste (wenn man das schon so machen will) heissen

Code:

---

Selection.Copy

---

statt

Code:

---

cell.EntireRow.Copy

---

Dann wird wahrscheinlich das Konstrukt

Code:

---

Range("C(i):AU(i)").Select

---

nicht funktionieren. Statt der geklammerten i musst Du da wohl sowas basteln

Code:

---

Range("C" & i & ":AU" & i).Select

---

Grüsse, Frank

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Frank, danke erstmal für die Antwort. Deine Änderungen sind klar und ich hab sie direkt eingearbeitet.

Der Code gestaltet sich wie folgt:

Code:

---

    Sub Test()
   
    strPath = "D:\Users\SimonStrauss\Documents\Sollstundenberechnung FAA\Rechner-Liste"
        strExt = "*.xls"
        Dim strFile As String
        If strPath = "" Then
            Exit Sub
        Else
            strFile = Dir(strPath & strExt)
            Do While Len(strFile) > 0
                Workbooks.Open Filename:=strPath & strFile
               
               
                Sheets("Verteilung").Select
                           
                Dim i As Integer
                Dim cell As Range
                i = 5
                For Each cell In Verteilung
                'Cluster 2
                          Cells("L83:R83").Select
                          Range("U91").Select
                          Range("J5").Select
                'Cluster 5
                          Cells("L196:R196").Select
                          Range("U204").Select
                          Range("U206").Select
                ' Cluster 8
                          Cells("L308:R308").Select
                          Range("U316").Select
                          Range("U318").Select
                ' Cluster 10
                          Cells("L428:R428").Select
                          Range("U436").Select
                          Range("U438").Select
                             
                  Selection.Copy
                  Windows("Zeitraumberechung Soll FAA-Std MakroTest2.xlsm").Activate
                  Sheets("Import").Select
                    Range("C" & i & ":AU" & i).Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                  :=False, Transpose:=False
                  i = i + 1
                  Next cell
                             
            Workbooks(strFile).Close
                strFile = Dir() ' nächste Datei
            Loop
        End If
   
    End Sub
                               

---

Er bringt jetzt auch keine Fehlermeldung mehr, passieren tut aber trotzdem nichts...

Ist den der Code für den oberen, bzw. unteren Teil in dem ich die einzelnen xls Dateien anwähle, öffne und schließe korrekt?

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Oh, das Zusammenbasteln des Pfad- und Dateinamens geht schonmal schief. Deine Extension heisst '*.xls'. Da würde ich das Sternchen weglassen. Oder, wenn sich da nix ändern soll, den String gleich komplett übergeben.

Ob das im Ganzen was werden kann, weiss ich nicht so recht. Das Auswählen und Kopieren mehrerer unzusammenhängender Bereiche funktioniert noch nicht mal manuell immer befriedigend - als Makro ist das eher fragwürdig. Ich spreche in solchen Fällen immer die Zellen direkt an, nacheinander und kopiere den Inhalt. Der Aufwand bleibt gleich, da das ja dann die Maschine macht. Also z.B.:

Code:

---

'Zeile 83, Spalte L...R (Blatt1) in Spalte E (Blatt2), Zeile 2...8
for i=12 to 18
  sheets(2).cells(i-10,5).value=sheets(1).cells(83,i).value
next

---

Dann solltest Du Dir nochmal Deine Loop ansehen. Mir ist da nicht klar, wo da der Name der nächsten Datei übergeben wird. Du bastelst das initial zusammen und machst dann die Zuweisung

Code:

---

strFile = Dir()

---

M.E. ist das unnötig, ebenso wie die if-then-else-Abfrage. Du gibst ja den Wert schon vor, also ist er weder leer noch die Länge gleich null.
Auch mit der for-each-Schleife habe ich Verständnisprobleme. Wo ist da die Begrenzung? Selbst wenn die Variable 'Verteilung' auf das Sheet "Verteilung" verweisen würde (was sie m.E. nicht tut), sind da noch ne ganze Menge Ranges=Cells drin. Auch hier ist ein Ansprechen per for-next oder do-loop zielführender.

Grüsse, Frank

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP