Uhrzeit kopieren und einfügen

[Kuwer]

Hallo Helmut,

vom aktiven Blatt ab sollte es so gehen:

Code:

Sub WoStu_NextMon_Uebertr()
 Dim arrMon As Variant, i As Long, j As Long
 Dim loErste As Long, loLetzte As Long
 Dim rngQ As Range
 
 arrMon = Array("Jänner", "Feber", "März", "April", "Mai", "Juni", "Juli", _
                "August", "September", "Oktober", "November", "Dezember")
 For i = 0 To 10
   If Array(i) = ActiveSheet.Name Then
     With Sheets(arrMon(i))
       loLetzte = .Range("A60").End(xlUp).Offset(-2, 0).Row
       loErste = .Range("B" & loLetzte).End(xlDown).Offset(0, 0).Row
   
       If .Cells(loErste + 6, 7).Value = 0 Then
         MsgBox "Noch keine Einträge in 'Wochenstunden-Tabelle ' " & .Name & " '" & vbLf & _
                 "Bitte jetzt eintragen!", vbExclamation, "Hinweis"
         Exit Sub
       Else
         Set rngQ = .Range(.Cells(loErste, 3), .Cells(loErste + 5, 6))
       End If
     End With

     For j = i + 1 To 11
       With Sheets(arrMon(i))
         loLetzte = .Range("A60").End(xlUp).Offset(-2, 0).Row
         loErste = .Range("B" & loLetzte).End(xlDown).Offset(0, 0).Row
         rngQ.Copy .Cells(loErste, 3)
       End With
     Next j
     
     Exit For
   End If
 Next i
End Sub

Gruß Uwe

[heli]

Hallo Uwe !

Vielen Dank für Deine neuerliche Hilfe.
Ich musste nur im unteren Teil eine kleine Änderung vornehmen, aber nun funktioniert es blendend.

For j = i + 1 To 11
        With Sheets(arrMon(j))
          loLetzte = .Range("A60").End(xlUp).Offset(-2, 0).Row
          loErste = .Range("B" & loLetzte).End(xlDown).Offset(0, 0).Row
          rngQ.Copy .Cells(loErste, 3)
       End With
        Next j
     Exit For
   End If
Next i

Liebe Grüße
Helmut

[Kuwer]

Hallo Helmut,

Fehler gefunden - sehr gut!    :19:

Gruß Uwe