Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1852to1856
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

end with ohne with, aber wo?

end with ohne with, aber wo?
05.11.2021 13:41:22
Eisi
Hallo zusammen,
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>

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: end with ohne with, aber wo?
05.11.2021 13:54:50
Michael
Vor Deinem Kommentar
' Ende: Zeilenhöhe einstellen
müsste eins fehlen.
Oder Du lässt das zweite
With tbl_AngebotDrucken
weg.
Gruß
Michael
AW: end with ohne with, aber wo?
05.11.2021 13:55:54
Werner
Hallo,
wenn du in deinem Code mit entsprechenden "Einrückungen" arbeiten würdest (wie man das auch tun sollte), dann würdes du auch sehen, wo was fehlt.
Dir fehlt nicht nur ein End With für With tbl_AngebotDrucken sondern auch ein Next für For lngZeile = 10 To lngZeileMax.
Hier dein Code entsprechend formatiert:

Sub KopiereNachAngebot_Zubehoer()
Dim loLetzteQuelle As Long, loLetzteZiel_TOP As Long, loLetzteZiel_BOTTOM As Long
Dim raBereich As Range, rngBereichFormat As Range, 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
Gruß Werner
Anzeige
AW: end with ohne with, aber wo?
05.11.2021 14:14:03
Eisi
Hallo Werner,
die Codes sind eigentlich alle eingerückt, weil ich das mit Auto-Macro schön einstellen kann. Den Durchblick habe ich leider trotzdem nicht mehr.
Im ganzen Code habe ich eigentlich nur den Bereich für die Zeilenhöhe eingefügt, weil die beim Kopieren nicht übernommen wird. Vorher ging der Code.
Zuerst meckert der Code weil "For next fehlt" habe ich eingefügt und jetzt meckert er weil with ohne end with.
Hast Du da noch einen Tipp für mich? Dankeschön. :-)

Sub KopiereNachAngebot_Zubehoer()
Dim loLetzteQuelle As Long, loLetzteZiel_TOP As Long, loLetzteZiel_BOTTOM As Long
Dim raBereich As Range, rngBereichFormat As Range, 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
Next lngZeile
' 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

Anzeige
AW: end with ohne with, aber wo?
05.11.2021 14:30:34
Werner
Hallo,
ist das so schwer zu sehen?
Du hast zweimal With tbl_AngebotDrucken aber nur einmal End With.
Das zweite With tbl_AngebotDrucken ist zudem überflüssig.

Sub KopiereNachAngebot_Zubehoer()
Dim loLetzteQuelle As Long, loLetzteZiel_TOP As Long, loLetzteZiel_BOTTOM As Long
Dim raBereich As Range, rngBereichFormat As Range, lngZeile As Long, lngZeileMax As Long
Application.ScreenUpdating = False
' 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
.Unprotect ("")
.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
Next lngZeile
' Ende: Zeilenhöhe einstellen
' 2) BOTTOM: Kopiere den *zweiten* Bereich >> unten
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
.Protect ("")
End With
MsgBox "Die Daten wurden übertragen", 0 + vbInformation, "Angebot: Zubehör nachträglich"
Application.CutCopyMode = False
Set raBereich = Nothing
End Sub
Gruß Werner
Anzeige
AW: end with ohne with, aber wo?
05.11.2021 21:35:55
Eisi
Hallo Werner,
da hast Du mehr als Recht. Danke.
Leider hängt jetzt der Code an dieser Stelle:
.Cells(loLetzteZiel_TOP, "B").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Ist da noch was raus zu lesen aus dem Code?
Danke schön.
VG Eisi :-)
AW: end with ohne with, aber wo?
06.11.2021 08:48:14
Werner
Hallo,
mit dieser Aussage Leider hängt jetzt der Code an dieser Stelle: kann kein Mensch was anfangen.
Fehler?, Welcher?, Fehlerbeschreibung?, Welchen Wert hat die Variable loLetzteZiel_BOTTOM wenn der Fehler auftritt?
Lad mal deine Mappe hier hoch.
Gruß Werner
AW: end with ohne with, aber wo?
06.11.2021 19:50:52
Eisi
ok, ok, knie mich am Montag nochmal rein.
Vielen Dank.
VG Eisi :-)
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige