Daten aus mehreren Dateien

Hallo zusammen,
ich benötige ein paar Codes, welche ich mittels CommandButton ausführen kann.
Ausgangssituation:
Ich habe 20 Erfassungsdateien (Datei1, Datei2,...) wo verschiede Personen in bestimmten Zellen Zahlen erfassen. Dann gibt es eine Auswertungsdatei, wo alles zusammengefasst werden soll.
Welche Codes ich benötige:
1. einen, der aus allen 20 Dateien, die Zellen A1, A3, A5, A7, B2, B4, B6, B8 zieht, die Zellen summiert (A1+A1+A1+...,B2+B2+B2+...) und die Summen in die Auswertungsdatei unter D1,D2,D3,D4,E1,E2,E3,E4 kopiert.
2. einen, der aus allen 20 Dateien, die Zellen A1, A3, A5, A7, B2, B4, B6, B8 zieht, die Zellen summiert (A1+A1+A1+...,B2+B2+B2+...) und die Summen in die Auswertungsdatei unter D1,D2,D3,D4,E1,E2,E3,E4 kopiert & in allen 20 Dateien die Werte dieser Zellen wieder auf Null setzt.
3. einen, der einen Zellbereich A30-D50 an bestimmte E-Mail-Adressen (test1 @Beispiel.de & test2@beispiel.de) versendet.
Könnt ihr mir helfen? Danke!
Viele Grüße
Christian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Kopieren() On Error GoTo Fehler Dim TB1, TB2, i%, j% Dim JaNein Dim Pfad$, Datname$, Ext$ Application.ScreenUpdating = False '*** Stammdaten Anfang Set TB1 = ActiveSheet Pfad = "C:\Temp\" Ext = ".xlsx" '*** Stammdaten Ende 'ggf #### TB1.Range("D1:E8").ClearContents 'Daten in AuswerteDatei löschen? JaNein = MsgBox("Ursprungsdaten löschen", vbYesNo + vbQuestion, "Datenkopieren") For i = 1 To 20 Datname = "Datei" & i & Ext Workbooks.Open Filename:=Pfad & Datname Set TB2 = Workbooks(Datname).Sheets(1) For j = 1 To 8 Step 2 TB1.Cells(j, 4) = TB1.Cells(j, 4) + TB2.Cells(j, 1) TB1.Cells(j + 1, 5) = TB1.Cells(j + 1, 5) + TB2.Cells(j + 1, 2) Next j If JaNein = vbYes Then 'Ursprungsdaten löschen TB2.Range("A1:B8").ClearContents Workbooks(Datname).Close SaveChanges:=True Else Workbooks(Datname).Close SaveChanges:=False End If Next i '*** Fehlerbehandlung Err.Clear Fehler: If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _ Clear End Sub

Hallo
Warum hast du nicht sofort die richtigen Zellen angegeben?
- - - -
Hier ist der Zielbereich angegeben, wenn du vorher löschen möchtest

    'ggf #### TB1.Range("D1:E8").ClearContents 'Daten in AuswerteDatei löschen?

Hier in einer Schleife die
Zielzelle:
TB1.Cells(j, 4) also
- im ersten Durchlauf Zeile1 / Spalte4 (D1) und
TB2.Cells(j + 1, 5) also
- Zeile2 /Spalte5 (E2)
Ursprungszelle:
TB2.Cells(j, 1) also Zeile1 / Spalte1 (A1)
TB2.Cells(j + 1, 2) also Zeile2 / Spalte2 (B2)
- im nächsten Durchlauf je 2 Zeilen tiefer
...

        For j = 1 To 8 Step 2
TB1.Cells(j, 4) = TB1.Cells(j, 4) + TB2.Cells(j, 1)
TB1.Cells(j + 1, 5) = TB1.Cells(j + 1, 5) + TB2.Cells(j + 1, 2)
Next j

Ausserdem noch das Löschen in den Ursprungsdateien

TB2.Range("A1:B8").ClearContents

- - -
Umbauen...
Dann wirst du 2 Schleifen bauen müssen
Eine für E3 bis E7

For j = 3 To 7 Step 2

Und danach eine für D9 bis D19 (in der gleichen Schleife für H9 bis H19)

For j = 9 To 19 Step 2

Gruß UweD

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten aus mehreren Dateien

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread