Thema: Eintragung von Reklamationen nach Reklamationscode

ClassModule: Tabelle2

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim vTour As Variant, vRek As Variant
   Dim iRow As Integer, iRowT As Integer
   If IsEmpty(Target) Then Exit Sub
   Select Case Target.Row
      Case 12
         vTour = Application.Match(Target, _
            Worksheets("Touren").Columns(1), 0)
         If IsError(vTour) Then
            Beep
            MsgBox "Die Tour wurde nicht gefunden!"
            Range("E12").Select
            End
         End If
      Case 13
         vTour = Application.Match(Range("E12"), _
            Worksheets("Touren").Columns(1), 0)
         With Worksheets("Touren")
            Do
               If .Cells(vTour, 2) = Target Then
                  iRow = vTour
                  Exit Do
               End If
               vTour = vTour + 1
            Loop Until .Cells(vTour, 1) <> _
               .Cells(vTour - 1, 1)
         End With
         If iRow = 0 Then
            Beep
            MsgBox "Die LfdNr wurde nicht gefunden!"
            Range("E13").Select
            End
         End If
      Case 14
         vTour = Application.Match(Range("E12"), _
            Worksheets("Touren").Columns(1), 0)
         With Worksheets("Touren")
            Do
               If .Cells(vTour, 2) = Range("E13") Then
                  iRow = vTour
                  Exit Do
               End If
               vTour = vTour + 1
            Loop Until .Cells(vTour, 1) <> .Cells(vTour - 1, 1)
         End With
         vRek = Application.Match(Target, _
            Worksheets("Code").Columns(1), 0)
         If IsError(vRek) Then
            Beep
            MsgBox "Der Reklamationscode wurde nicht gefunden!"
            Range("E14").Select
            End
         End If
         With Worksheets("Reklamationen")
            iRowT = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Cells(iRowT, 1) = Worksheets("Touren").Cells(iRow, 3)
            .Cells(iRowT, 2) = Worksheets("Touren").Cells(iRow, 4)
            .Cells(iRowT, 3) = Worksheets("Touren").Cells(iRow, 6)
            .Cells(iRowT, 4) = Worksheets("Code").Cells(vRek, 2)
         End With
   End Select
End Sub

Private Sub Msg()
   Beep
   MsgBox "Eingabe nicht korrekt!"
   End
End Sub

Beiträge aus dem Excel-Forum zu den Themen Ereignis und Change