Zellen auslesen und dann Kopieren
11.01.2007 14:43:08
Ralf
Hallo alle zusammen
Habe dieses Thema schon einmal in diesem Forum gestellt aber ich glaube das ich es nicht gut genug beschrieben habe. Versuche es deshalb ei weiteres mal.
Ich habe mir einen Stundenzettel erstellt wo in Spalte D die namen Der Baustelle eingetragen werden und in Spalte F die dazugehörigen stunden.
Nun möchte ich , das in einem Tabellenblatt " Auswertung " die spalten D und F mittels makro ausgelesen werden und dann Die namen Der Baustelle im Tabellenblatt Auswertung in B eingeragen werden und die Dazugehörigen Stunden in c .
Wenn Die Baustelle den gleichen namen haben, möchte ich das die Stunden zusammengezählt werden und der name der Baustelle nur ein mal in der Auswertung erscheint.
Hoffe das ich mich gut ausgedrückt habe.
Habe schon ein makro aber das muss noch umgeändert werden und nach einigen veruchen es selbst zu lösen habe ich es aufgegeben
Dieses makro steht im modul 1
Sub Auswertung()
Dim ws1 As Worksheet
Set ws1 = Worksheets("Auswertung")
Set ws2 = Worksheets("Daten")
For i = 1 To Sheets.Count
If Sheets(i).Name <> "Daten" And Sheets(i).Name <> "Auswertung" And Sheets(i).Name <> "Monatsblatt" Then
ws2.Cells(i, 1).Value = Sheets(i).Name
End If
Next i
f = 0
anz = ws2.Cells(65356, 1).End(xlUp).Row
anz2 = ws1.Cells(65356, 3).End(xlUp).Row
ws1.Range("C4:C" & anz2 + 1).ClearContents
For z = 1 To anz
If ws2.Cells(z, 1) <> "" Then
tabe = ws2.Cells(z, 1)
Set ws3 = Worksheets(tabe)
For z1 = 8 To 100
f = 0
If ws3.Cells(z1, 3) <> "" Then
anz1 = ws1.Cells(65356, 2).End(xlUp).Row
For z2 = 4 To anz1
If ws1.Cells(z2, 2) <> "" Then
If ws1.Cells(z2, 2) = ws3.Cells(z1, 3) Then
ws1.Cells(z2, 3) = ws1.Cells(z2, 3) + ws3.Cells(z1, 4)
f = 1
End If
End If
Next z2
If f = 0 Then
ws1.Cells(z2, 2) = ws3.Cells(z1, 3)
ws1.Cells(z2, 3) = ws1.Cells(z2, 3) + ws3.Cells(z1, 4)
End If
End If
Next z1
End If
Next z
End Sub
Die Tabelle
https://www.herber.de/bbs/user/39579.xls