'******************************************************************************
' Modul: mdl_getSAP / erstellt : .....  am : 01.05.2015
'------------------------------------------------------------------------------
' Zweck / Inhalt :
' Sheets(1) aus Spalte "B" die auszuwählenden ArtikelNr
' in Sheets(2) die Zelle ("D8"), wo die ArtikelNr. auftauchen soll
' dass immer eine Zeile bei Sheets(2) frei bleiben soll
'******************************************************************************
'
Option Explicit
'
Sub DoIt()
'
'******************************************************************************
' Name : DoIt / erstellt : 01.05.2015 / 18:06 / Sub
'------------------------------------------------------------------------------
' mit Blattschutz arbeite
' Worksheet.Protect Method (Excel)
' UserInterfaceOnly - Optional - Variant
' TRUE to protect the user interface, but not macros !!!
'******************************************************************************
'
Const cCOLUMN As Long = 2  'Spalte "B"
Const cSHEET As String = "Tabelle2"
Const cADDRESS As String = "D8"
Dim sAddress As String
'
   sAddress = GetIt
   If Len(sAddress) > 0 Then
      If Not Intersect(Columns(cCOLUMN), Range(sAddress)) Is Nothing Then
         Range(sAddress).Copy Destination:=ChkIt(cSHEET, cADDRESS)
      End If
   End If
'
End Sub
Private Function GetIt() As String
   Application.DisplayAlerts = False
   On Error Resume Next
   GetIt = Application.InputBox( _
      prompt:="Selektiere ArtikelNr", _
      Title:="mdl_getSAP", _
      Type:=8).Address
   On Error GoTo 0
   Application.DisplayAlerts = True
End Function
Private Function ChkIt(sName As String, sAddress As String) As Range
Dim Rng As Range
With Sheets(sName)
   Set Rng = .Range(sAddress)
   If Rng.Value = "" Then
      Set ChkIt = Rng
   Else
      Set ChkIt = .Cells(Rows.Count, Rng.Column).End(xlUp).Offset(2)
   End If
End With
End Function