Clever-Excel-Forum

Seiten: 1 2

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

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

Hallo Helmut,

Fehler gefunden - sehr gut! Thumps_up

:19:

Gruß Uwe

Seiten: 1 2

Kuwer

heli

Kuwer