Option Explicit
Private WithEvents m_wkbSource As Excel.Workbook
Private Const C_SOURCE_SHEET_NAME As String = "Stammdatenliste"
Private Sub m_wkbSource_BeforeClose(Cancel As Boolean)
Set m_wkbSource = Nothing
End Sub
Private Sub m_wkbSource_SheetChange(ByVal Sh As Object, ByVal Target As Range)
m_wkbSource.Saved = True
End Sub
Private Sub m_wkbSource_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If 0 = StrComp(Sh.Name, C_SOURCE_SHEET_NAME, vbTextCompare) _
Then
If Target.Column = 1 Then
Cancel = True
Else
Exit Sub
End If
Else
Exit Sub
End If
Dim lngDstCOffset As Long
Dim rngDstRHeader As Excel.Range
Dim rngSrcCHeader As Excel.Range
Set rngDstRHeader = GetHeader()
Set rngSrcCHeader = Sh.Range("A1", Sh.Cells(1, Sh.Columns.Count).End(xlToLeft))
With rngDstRHeader.Worksheet
lngDstCOffset = .Cells(rngDstRHeader.Cells(1).Row, .Columns.Count).End(xlToLeft).Offset(0, 1).Column
lngDstCOffset = lngDstCOffset - rngDstRHeader.Column
End With
Dim rngSrcField As Excel.Range
Dim rngDstField As Excel.Range
For Each rngDstField In rngDstRHeader.Cells
Set rngSrcField = rngSrcCHeader.Find( _
What:=rngDstField.Value, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
Searchorder:=xlByRows, _
MatchCase:=False)
If Not rngSrcField Is Nothing Then
rngDstField.Offset(0, lngDstCOffset).Value = rngSrcField.Worksheet.Cells(Target.Row, rngSrcField.Column).Value
End If
Next
Call MsgBox("Datensatz wurden übernommen.", vbInformation)
End Sub
Public Sub OpenMasterData()
If Not m_wkbSource Is Nothing Then
Call m_wkbSource.Close(SaveChanges:=False)
Set m_wkbSource = Nothing
End If
Dim vntFilename As Variant
vntFilename = Split(ThisWorkbook.Path, Delimiter:=Application.PathSeparator, Limit:=2)
Call ChDrive(vntFilename(0))
Call ChDir(vntFilename(0) & Application.PathSeparator & vntFilename(1))
vntFilename = Application.GetOpenFilename("Excel Stammdatenliste (*.xls*),*.xls*", Title:="Stammdatenliste auswählen")
If VarType(vntFilename) = vbBoolean Then
Exit Sub
ElseIf 0 = StrComp(vntFilename, ThisWorkbook.FullName, vbTextCompare) Then
Call MsgBox("Ich soll mich selbst öffnen?" & vbNewLine & _
"Nope, du zuerst! :P", _
vbExclamation)
Exit Sub
End If
Set m_wkbSource = Workbooks.Open(vntFilename, ReadOnly:=True)
Call MsgBox("Wählen Sie die zu übertragenen Datensätze per Doppelklick in der Spalte ""Name"" aus." & vbNewLine & _
"Anschließend können Sie die Mappe wieder schließen.", _
Title:=ThisWorkbook.Name, _
Buttons:=vbInformation)
End Sub
Private Function GetHeader() As Excel.Range
Set GetHeader = Range("A1", Cells(Rows.Count, "A").End(xlUp))
End Function
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With GetHeader()
If .Row <= Target.Row And Target.Row <= .Rows(.Rows.Count).Row _
And .Column <= Target.Column And Target.Column <= .Rows(.Columns.Count).Column _
Then
Cancel = True
Call OpenMasterData
End If
End With
End Sub