Arbeiten mit 2 Workbooks
30.05.2022 20:26:59
Andreas
folgender Code läuft- aber es gibt Fehleintragungen bzw. Fehler, wenn ich das Makro nicht aus dem Worksheet "DRUCKMASKE" im Worbooks "BEARBEITEN" starte.
Vieleicht müsste hier etwas mit Variable in der Zuordnung der Datein rein? Problem hierbei die Aktivation einer anderen Datei- "Workbooks.Open Filename:="D:\ABLAGE\LISTE.xlsm"
dort wird eine Identnummer erstellt und gespeichert. Diese Nummer wird wieder ins Worbooks "BEARBEITEN" ins Worksheet "DRUCKMASKE" eingetragen.
Mir wäre es sicherer, wenn ich das Makro auch aus anderen Tabellenblätter starten kann, aber die Einfügedaten trotzdem ins richtige Blatt kommen.
Option Explicit
Sub Listen_Nr_Vergabe()
Dim iClick As Integer
iClick = MsgBox( _
prompt:="Listen Nummer Vergabe!", _
Buttons:=vbOKOnly)
Workbooks.Open Filename:="D:\ABLAGE\LISTE.xlsm"
Application.CutCopyMode = False 'Zwischenspeicher löschen
Dim Zeile As Long
Zeile = Range("O65536").End(xlUp).Row
MsgBox "Letzter Eintrag ist in Zeile Nr. " & Zeile
Windows("BEARBEITEN.xlsm").Activate
Range("AC28").Select
Application.CutCopyMode = False
Selection.Copy
Windows("LISTEN.xlsm").Activate
Application.Goto Range("O65536").End(xlUp).Offset(1, 0)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.Goto Range("O65536").End(xlUp).Offset(0, -1)
Application.CutCopyMode = False
Selection.Copy
Windows("BEARBEITEN.xlsm").Activate
Range("Y35").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("W35:Z35").Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Windows("LISTEN.xlsm").Activate
Application.Goto Range("O65536").End(xlUp).Offset(1, -1)
Windows("LISTEN.xlsm").Activate
Application.CutCopyMode = False 'Zwischenspeicher löschen
ActiveWorkbook.Close True
End Sub