AW: Tabellen zusammenfassen per Optionsfeld
27.10.2007 20:56:30
andre
Hallo Sepp,
ich habe den Code an der angegebenen Stelle eingefügt und angepasst
das Makro bleibt aber an dieser Stelle stehen nachdem es den Code durchlaufen hat, erst wenn ich den Button wieder drücke werden die Tabellen in die Ausgabe kopiert doch dann bin ich schon wieder im Auswahlmenue. Habe einiges probiert komme aber nicht so recht weiter.
Gruß
Andre
Option Explicit
Sub create_XML()
Dim rng As Range
Dim objWS As Worksheet, objAUSGABE As Worksheet
Set objAUSGABE = Sheets("Ausgabe")
If Application.CountIf(Range("L1:L15"), True) = 0 Then Range("L1:L15").Value = True
For Each rng In Range("L1:L15")
If rng = True Then
Set objWS = Sheets("Tabelle" & rng.Row + 1)
objWS.Range("A1:C" & objWS.Cells(Rows.Count, 1).End(xlUp).Row).Copy _
objAUSGABE.Cells(objAUSGABE.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
End If
Next
objAUSGABE.Rows(1).Delete
' hier bleibt der Code stehen ohne Fehlermeldung
' auch werden die 15 Tabellen richtig ausgefüllt
' erst wenn man ein zweites mal startet werden die ausgewählten
' Blätter in die Ausgabe kopiert aber dann neu überschrieben
Set objWS = Nothing
Set objAUSGABE = Nothing
Set rng = Nothing
End Sub
Sub Check_All()
If Range("L1").Value = True Then
Range("L1:L15").Value = False
Else
Range("L1:L15").Value = True
End If
End Sub
Private Function fncBrowseForFolder(Optional ByVal defaultPath = "") As String
Dim objFlderItem As Object, objShell As Object, objFlder As Object
Set objShell = CreateObject("Shell.Application")
Set objFlder = objShell.BrowseForFolder(0&, "Ordner auswählen...", 0&, defaultPath)
If objFlder Is Nothing Then GoTo ErrExit
Set objFlderItem = objFlder.Self
fncBrowseForFolder = objFlderItem.Path
ErrExit:
Set objShell = Nothing
Set objFlder = Nothing
Set objFlderItem = Nothing
End Function