zina.houbi@yahoo.de

Forumthread: zina.houbi@yahoo.de

zina.houbi@yahoo.de

26.02.2020 13:57:11

Tara

Hallo Herber Forum,
ich habe folgendes Problem, ich habe einen Makro gebastelt, der als Strichliste dienen soll.
Nun soll in der angehängten Masterdatei auf den Order wo alle Strichlisten(verschiedene Kollegen) liegen, zugegriffen werden und die Werte in der Masterdatei für alle Kollegen addiert werden.
Leider weiß ich nicht wie ich das über VBA lösen klann, kann mir da jemand helfen bitte?
Vielen Dank :)
https://www.herber.de/bbs/user/135455.xlsm

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: zina.houbi@yahoo.de

26.02.2020 17:29:41

onur
Daten übertragen

26.02.2020 18:00:40

Nepumuk
AW: zina.houbi@yahoo.de

26.02.2020 19:20:06

volti

AW: zina.houbi@yahoo.de

26.02.2020 17:29:41

onur

Betreff: zina.houbi@yahoo.de ?

Daten übertragen

26.02.2020 18:00:40

Nepumuk

Hallo,
wie sieht denn die Masterdatei aus und wie lautet ihr Pfad?
Gruß
Nepumuk

AW: zina.houbi@yahoo.de

26.02.2020 19:20:06

volti

Hallo Zina,
hier mal ein Ansatz, eine Idee, wie Du das machen könntest.
Habe unterstellt, dass sich die Kollegendateien im Unterordner "\Kollegen" des Ordners, wo diese Datei liegt, befinden.
Die Summe wird in der Masterdatei abgelegt, die genauso aussieht, wie die einzelnen Kollegendateien.
Damit das fix geht, erfolgt die Addierung in einem Array, dessen Daten dann einfach über die Summentabelle übergestülpt wird.
Probier mal aus, ob es Deiner Vorstellung entspricht....
Masterdatei.xlsm

Option Explicit

Option COMPARE TEXT

Sub SummeBilden()

 Dim sPath As String, sFile As String

 Dim sArr(77, 5) As Variant, iZeile As Long, iSpalte As Integer

 sPath = ThisWorkbook.Path & "\Kollegen\"   'Pfad ggf. anpassen

 sFile = Dir$(sPath & "*.xls*")             'Dateimaske ggf. anpassen

'Alle Dateien nacheinander öffnen und Werte im Array addieren

 Do While sFile &LT;&GT; ""

  With GetObject(PathName:=sPath & sFile)

     Application.StatusBar = sFile & " wird gerade bearbeitet...."

     For iZeile = 0 To 72

      For iSpalte = 0 To 5

       If .Sheets(1).Cells(iZeile + 5, iSpalte + 5).Value &LT;&GT; "" Then _

       sArr(iZeile, iSpalte) = _

       sArr(iZeile, iSpalte) + .Sheets(1).Cells(iZeile + 5, iSpalte + 5).Value

      Next iSpalte

     Next iZeile

     .Close SaveChanges:=False

  End With

  sFile = Dir$

 Loop

'Daten ausgeben

 With ThisWorkbook.Sheets(1)

   .Range("$E5:$I$77").ClearContents

   .Cells(5, 5).Resize(73, 5).Value = sArr()

 End With

 MsgBox "Daten übertragen fertig!", vbInformation, "Daten übertragen"

End Sub

viele Grüße
Karl-Heinz

Beliebteste Forumthreads (12 Monate)

Forumthread: zina.houbi@yahoo.de

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread