leider ist der Original-Thread von letzter Woche nicht mehr verfügbar, daher ein neuer.
Siehe auch https://www.herber.de/forum/archiv/1460to1464/t1462444.htm
Welchen Bereich muss ich ändern, damit nicht nur Zeile 2 und 3 geändert werden?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim varRet As Variant
Dim lngC As Long, lngRow As Long
Dim CalculationMode As Long
On Error GoTo ErrorHandler
With Application
.ScreenUpdating = False
.EnableEvents = False
CalculationMode = .Calculation
.Calculation = xlManual
.DisplayAlerts = False
End With
If Target.Address(0, 0) = "B1" Then
For Each rng In Me.Range("B2:B" & Application.Max(2, Me.Cells(Me.Rows.Count, 2).End(xlUp).Row) _
)
If rng "" Then
If SheetExist(rng.Text) Then
With Sheets(rng.Text)
varRet = Application.Match(Target, .Columns(1), 0)
If IsNumeric(varRet) Then
lngRow = varRet
For lngC = 3 To 22
varRet = Application.Match(Me.Cells(1, lngC), .Rows(1), 0)
If IsNumeric(varRet) Then
Me.Cells(rng.Row, lngC) = .Cells(lngRow, varRet)
Else
Me.Cells(rng.Row, lngC) = "#NA"
End If
Next
End If
End With
End If
End If
Next
End If
ErrorHandler:
With Err
If .Number 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'nn'" & vbLf & String(25, "") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, 81968, "VBA - Fehler in Prozedur - collectData", .HelpFile, . _
HelpContext
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalculationMode
.DisplayAlerts = True
.StatusBar = False
End With
End Sub
Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
Dim wks As Object
On Error GoTo ErrorHandler
If Wb Is Nothing Then Set Wb = ThisWorkbook
For Each wks In Wb.Sheets
If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
Next
ErrorHandler:
SheetExist = False
End Function
Gruß und Danke vorab
TOM