Ist es jetz nun möglich alle Tabellenblaätter, und ihre Bereiche, in in eine html-Datie abzuspeichern?
Hier ist noch der Link zur Detei (Das Makro ist noch nicht überarbeitet un man könnte es noch effizienter machen!): https://www.herber.de/bbs/user/31389.xls
Hier wäre noch eine andere Version von "Reinhard", welche aber nicht richtig funktioniert, vielleicht findet ja jemand den Fehler:
Option Explicit
Option Base 1
Private Sub btnSprueche_Click()
Dim zei As Long, n As Byte, zei4 As Long, ws4 As Worksheet, Blatt
Blatt = Array("Tabelle1", "Tabelle9", "Tabelle12", "Tabelle2")
Set ws4 = Worksheets(Blatt(UBound(Blatt)))
For n = 1 To UBound(Blatt) - 1
With Worksheets(Blatt(n))
zei = 1
While (.Cells(zei + 1, 1) & .Cells(zei + 2, 1) & .Cells(zei + 3, 1) <> "")
zei = zei + 1
Wend
zei4 = IIf(n = 1, 1, ws4.Range("A65536").End(xlUp).Row + 1)
.Range(Cells(1, 2), Cells(zei, 2)).Copy ws4.Cells(zei4, 1)
End With
Next n
Range(Cells(1, 1), Cells(zei4 + zei, 2)).Select
With ActiveWorkbook.PublishObjects.Add(xlSourceRange, _
"C:\Dokumente und Einstellungen\Simon\Desktop\sprueche_makro.htm", Blatt(4), _
"" & Range(Cells(1, 1), Cells(zei4 + zei, 2)).Address & "", xlHtmlStatic, Blatt(4), "")
.Publish (True)
.AutoRepublish = False
End With
End Sub
Für das Tabellenblatt1 (ws1) funktioniert das ganze, aber wenn dann n grösser als 1 ist (also das erste mal bei n=2)""With Worksheets(Blatt(n))"", dann kommt eine Fehlermeldung "Index ausserhalb des gültigen Bereichs"!!
danke im voraus
simi