AW: Werte holen
07.09.2016 21:51:29
fcs
Hallo Dirk,
hier schon mal eine Variante als Ereignis-Makro. Dabei muss die Datei, in der in Spalte A:A gesucht werden soll, geöffnet sein.
LG
Franz
'Ereignis-Makro unter dem Tabellenblatt "TB_Test1" in Datei "Test1.xlsm"
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim varFind
Dim wksZiel As Worksheet
Dim wkbQuelle As Workbook
Dim wksQuelle As Worksheet
Dim Zelle As Range
Dim rngCopy As Range
Dim Zeile_L As Long
If Target.Cells.Count = 1 Then
'über die Case-Zeilen kann der Spalten bzw. Zeilenbereich festgelegt werden, in dem _
der Doppelklick die Suche auslösen soll
Select Case Target.Column
Case 1 To 21
Select Case Target.Row
Case Is >= 2
varFind = Cells(Target.Row, 21).Value 'Wert in Spalte U
If Not (varFind = "" Or IsEmpty(varFind)) Then
Set wksZiel = ThisWorkbook.Worksheets("TB_Test2")
'Die Quelldatei muss paralle zu Datei "Test1.xlsm" geöffnet sein.
Set wkbQuelle = Application.Workbooks("Test2.xlsm")
Set wksQuelle = wkbQuelle.Sheets(1)
Set Zelle = wksQuelle.Range("A:A").Find(What:=varFind, _
LookIn:=xlValues, lookat:=xlWhole)
If Zelle Is Nothing Then
MsgBox "Suchbegriff """ & varFind _
& """ in Quelltabelle nicht gefunden", _
vbOKOnly, "Suchen + Kopieren"
Else
With wksQuelle
'zu kopierenden Bereich in Zeile setzen Spalte A bis AB
Set rngCopy = .Range(.Cells(Zelle.Row, 1), _
.Cells(Zelle.Row, 28))
End With
With wksZiel
Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(Zeile_L, 1).Value = "" Then
Zeile_L = 1
Else
Zeile_L = Zeile_L + 1
End If
rngCopy.Copy Destination:=.Cells(Zeile_L, 1)
End With
Set rngCopy = Nothing
Set wkbQuelle = Nothing
Set wksQuelle = Nothing
End If
End If
Cancel = True
End Select
End Select
End If
End Sub