Unterstützung Prüfen...
31.01.2023 14:32:13
walter
anbei mein Makro, welches ich vom Kollegen mal erhalten habe und auf mich zugeschnitten habe.
Jetzt habe ich noch ein kleines.... Problem, da ich ich nicht so tief in VBA drin bin.
Ich möchte, wenn die Anschrift kopiert werden soll, das nach der Nummer (K11) aus der zu kopierenden Tabelle,
in der Spalte B in der zu kopierenden Datei/Tabelle, geprüft wird.
Wenn die Nummer vorhanden ist, wenn ja überschreiben, sonst einfach unten anfügen (das klappt ja).
Public Sub Namen_in_Lager_Gesamt_kopieren() Dim wksQUELLE As Worksheet 'Quell-Worksheet Dim wksZIEL As Worksheet 'Ziel-Worksheet Dim wkbZIEL As Workbook, wkbQUELLE As Workbook Dim rngZIEL As Range Dim strSUCH As String Const cstr_wkbQUELLE As String = "Lager_Gesamt.xlsm" Const cstr_wksQUELLE As String = "Lager_1" Const getStrPassWort = "tk" Set wkbQUELLE = ActiveWorkbook Set wksQUELLE = ActiveSheet On Error Resume Next Set wkbZIEL = Workbooks(cstr_wkbQUELLE) On Error GoTo 0 If wkbZIEL Is Nothing Then Set wkbZIEL = Workbooks.Open("D:\" & cstr_wkbQUELLE) End If 'Worksheet-Variable setzen Set wksZIEL = wkbZIEL.Worksheets(cstr_wksQUELLE) '"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" Dim lFile Dim lloRow As Long, ldtRgDate As Date, lstrRgNr As String, lboOK As Boolean, lloRNext As Long Dim wks, shs, pshDB Application.EnableEvents = False Application.ScreenUpdating = False wkbZIEL.Activate wkbQUELLE.Activate 'Suchergebnis prüfen: strSUCH nicht gefunden: Am Ende Anfügen If rngZIEL Is Nothing Then Set rngZIEL = wksZIEL.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) 'Offset(1, 0 = 1 zeile drunter End If ' jetzt übertragen wksZIEL.Unprotect "tk" '(getStrPassWort) wksQUELLE.Range("K11:K21").Copy rngZIEL.Offset(0, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True wksZIEL.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=getStrPassWort Application.CutCopyMode = False wkbQUELLE.Activate 'Datei wksQUELLE.Activate 'Sheet wksQUELLE.Range("K12").Select Application.EnableEvents = False Application.ScreenUpdating = False End SubIch würde mich freuen, wenn ich hier eine Hilfe erhalten würde,
danke im Voraus
mfg
walter b