VBA mehrere Datenblätter kopieren
12.01.2022 06:42:56
Verena
ich habe in der Arbeit ein Projekt, das ich mit VBA verwirklichen möchte und mir dadurch eine Arbeitszeit ersparen könnte. Ich arbeite in der Arbeit mit Office 2013 und muss auch dazu sagen, dass ich erst vor ein paar Tagen mit VBA angefangen habe und somit ein absoluter VBA-Anfänger bin!
Ich habe 8 Tabellenblätter
Montag/Dienstag/Mittwoch/Donnerstag/Freitag/Samstag/Sonntag/Übersicht
In einzelnen Tagen trage ich jeden Tag ein, wo meine Mitarbeiter gewesen sind. Ich möchte nun die einzelnen Tabellenreiter am Ende der Woche zusammenfassen und einen Block in den Tabellenreiter Übersicht übertragen aber nur wenn eine Bedingung im jeweiligen Tabellenblatt erfüllt ist..
Ich habe es bisher nur hinbekommen per Marko eine Zeile in die Übersicht zu übertragen. Ich stehe jetzt irgendwie vor dem Problem auch einen ganzen Block zu übertragen. Es könnte natürlich sein das ich es mir etwas umständlich gemacht habe beim Code aber ich stehe erst am Anfang mit meinen VBA Kenntnissen.
Hat jemand eine Idee oder kann mir da weiterhelfen?
Liste:
https://www.herber.de/bbs/user/150344.xlsm
Und der Code:
Private Sub CommandButton1_Click()
Dim lngZeile As Long
Dim lngErste As Long
With Worksheets("Übersicht")
For lngZeile = 5 To 50
If Worksheets("Montag").Cells(lngZeile, 1) = "Montag" Then
lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
Worksheets("Montag").Rows(lngZeile).Copy .Cells(lngErste, 1)
End If
Next lngZeile
For lngZeile = 5 To 50
If Worksheets("Dienstag").Cells(lngZeile, 1) = "Dienstag" Then
lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
Worksheets("Dienstag").Rows(lngZeile).Copy .Cells(lngErste, 1)
End If
Next lngZeile
For lngZeile = 5 To 50
If Worksheets("Mittwoch").Cells(lngZeile, 1) = "Mittwoch" Then
lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
Worksheets("Mittwoch").Rows(lngZeile).Copy .Cells(lngErste, 1)
End If
Next lngZeile
For lngZeile = 5 To 50
If Worksheets("Donnerstag").Cells(lngZeile, 1) = "Donnerstag" Then
lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
Worksheets("Donnerstag").Rows(lngZeile).Copy .Cells(lngErste, 1)
End If
Next lngZeile
For lngZeile = 5 To 50
If Worksheets("Freitag").Cells(lngZeile, 1) = "Freitag" Then
lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
Worksheets("Freitag").Rows(lngZeile).Copy .Cells(lngErste, 1)
End If
Next lngZeile
For lngZeile = 5 To 50
If Worksheets("Samstag").Cells(lngZeile, 1) = "Samstag" Then
lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
Worksheets("Samstag").Rows(lngZeile).Copy .Cells(lngErste, 1)
End If
Next lngZeile
For lngZeile = 5 To 50
If Worksheets("Sonntag").Cells(lngZeile, 1) = "Sonntag" Then
lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
Worksheets("Sonntag").Rows(lngZeile).Copy .Cells(lngErste, 1)
End If
Next lngZeile
End With
End Sub