Thema: Von der Fundstelle eines Zellwertes abhängige Daten eintragen

StandardModule: basMain

Sub BegriffSuchen()
   Dim rng As Range
   Dim sBegriff As String
   sBegriff = Range("B20")
   Set rng = Range("A1").CurrentRegion.Find(sBegriff, lookat:=xlWhole)
   If rng Is Nothing Then
      Beep
      MsgBox "Nein, Begriff wurde nicht gefunden!"
      Exit Sub
   End If
   With Worksheets("Tabelle2")
      .Range("A1") = "Kopfzeile:"
      .Range("A2") = Cells(1, rng.Column)
      .Range("B1") = "Vorgängerzelle:"
      If rng.Row = 2 Then
         If rng.Column = 1 Then
            Beep
            MsgBox "Es gibt keine Vorgängerzelle!"
            Exit Sub
         End If
         .Range("B2") = rng.Offset(0, -1)
      ElseIf rng.Column = 1 Then
         .Range("B2") = rng.Offset(-1, Range("A1") _
            .CurrentRegion.Columns.Count - 1)
      Else
         .Range("B2") = rng.Offset(0, -1)
      End If
      .Columns.AutoFit
   End With
   Worksheets("Tabelle2").Select
End Sub

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Bearbeiten