end with ohne with, aber wo?
05.11.2021 13:41:22
Eisi
irgendwo fehlt das end with, aber ich komme nicht drauf. Kann jemand die Stelle erkennen, wo es hakt?
Danke.
VG Eisi :-)
<pre>Sub KopiereNachAngebot_Zubehoer()
Dim loLetzteQuelle As Long, loLetzteZiel_TOP As Long, loLetzteZiel_BOTTOM As Long
Dim raBereich As Range
Dim rngBereichFormat As Range
Dim lngZeile As Long, lngZeileMax As Long
Application.ScreenUpdating = False
tbl_AngebotDrucken.Unprotect ("")
' 1) TOP: Kopiere den *ersten* gefilterten Bereich >> oben
With tbl_1_Kalkulation
Set raBereich = .Range("F71:P89")
loLetzteQuelle = .Cells(.Rows.Count, "A").End(xlUp).Row
loLetzteZiel_TOP = tbl_AngebotDrucken.Cells(Rows.Count, "B").End(xlUp).Offset(2).Row
.Range("A75:P" & loLetzteQuelle).AutoFilter Field:=2, Criteria1:="<>", Operator:=xlFilterValues
raBereich.Copy
.Range("A75").AutoFilter
End With
' Übertrage die Copy ins AngebotDrucken
With tbl_AngebotDrucken
.Cells(loLetzteZiel_TOP, "B").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Cells(loLetzteZiel_TOP, "B").PasteSpecial Paste:=xlPasteFormats
' Formatiere die letzte Linie fett.
Set rngBereichFormat = .Range("B10:L" & .Range("B" & Rows.Count).End(xlUp).Row)
rngBereichFormat.Borders(xlEdgeBottom).Weight = xlMedium
'?
' Hier stimmt etwas nicht. Ohne diesen Bereich hat der Code vorher funktioniert.
'?
' Stelle die Zeilenhöhe der Überschrift (Artikelnummer)im AngebotDrucken auf 39 ein.
lngZeileMax = .Range("B" & .Rows.Count).End(xlUp).Row
For lngZeile = 10 To lngZeileMax
If .Range("B" & lngZeile).Interior.Color = 16638867 Then ' Farbnummer für Zubehör suchen.'
.Range("B" & lngZeile).Cells(8, 1).RowHeight = 39
End If
' Ende: Zeilenhöhe einstellen
' 2) BOTTOM: Kopiere den *zweiten* Bereich >> unten
With tbl_AngebotDrucken
Range("BOTTOM_Zubehoer").Copy 'Formelname: BOTTOM_Zubehoer >> Sheet: 1_Kalkulation > Bereich F35:P43
loLetzteZiel_BOTTOM = .Cells(Rows.Count, "B").End(xlUp).Offset(1).Row
.Cells(loLetzteZiel_BOTTOM, "B").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Cells(loLetzteZiel_BOTTOM, "B").PasteSpecial Paste:=xlPasteFormats
End With
MsgBox "Die Daten wurden übertragen", 0 + vbInformation, "Angebot: Zubehör nachträglich"
tbl_AngebotDrucken.Protect ("")
Application.CutCopyMode = False
Set raBereich = Nothing
End Sub</pre>