Gruppe
Ereignis
Problem
Bei einer Eingabe eines Wertes in Spalte B soll dieser Wert in einer anderen Arbeitsmappe in Zeile1 und der Wert aus Spalte A dort in Spalte A gesucht werden. Die Formatierung aus der Fundzelle soll übernommen werden.
ClassModule: Tabelle1
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then Call ReadFormatting(Target.Offset(0, -1))
End Sub
StandardModule: Modul1
Sub ReadFormatting(rng As Range)
Dim vRow As Variant, vCol As Variant
Dim sFile As String
Application.ScreenUpdating = False
sFile = ThisWorkbook.Path & "\test1.xls"
If Dir(sFile) = "" Then
Beep
MsgBox "Testarbeitsmappe ist nicht vorhanden!"
Exit Sub
End If
Workbooks.Open sFile, False
Worksheets("160901").Select
vRow = Application.Match(rng.Value, Columns(1), 0)
vCol = Application.Match(rng.Offset(0, 1).Value, Rows(1), 0)
If Not IsError(vRow) And Not IsError(vCol) Then
Cells(vRow, vCol).Copy
rng.Offset(0, 2).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End If
ActiveWorkbook.Close savechanges:=False
Application.ScreenUpdating = True
End Sub
Sub SetFormula()
Dim sFile As String, sFormula As String
sFile = "'" & ThisWorkbook.Path & "\[test1.xls]160901'!"
sFormula = "=INDEX(" & sFile & "$A$1:$F$6,MATCH(A1," & _
sFile & "A:A,0),MATCH(B1," & sFile & "1:1,0))"
Range("C1").Formula = sFormula
End Sub