Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 14:48:50
"Eingabefeld" zwischen zwei Zeilen geht nicht weg.
24.04.2024 14:40:10
Zeilenumbrüche in Textbox zählen
24.04.2024 14:06:20
Gesamte Column löschen, wenn Column-Bereich leer
24.04.2024 13:44:05
Bezeichnung Tabellenblatt aus Zelle für Formel auslesen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
776to780
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
776to780
776to780
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

per Markierung ausgew Tab. verschieben - kopieren

per Markierung ausgew Tab. verschieben - kopieren
30.06.2006 16:07:47
Fritz
Hallo Forum,
in der Tabelle2 sind in der Spalte D (Bereich D2:D31) bestimmte Tabellennamen der Arbeitsmappe (nicht alle Tabellen) aufgeführt. In der Spalte E (E2:E31)sind einzelne dieser Tabellennamen (jeweils in der gleichen Zeile) mit "x" gekennzeichnet.
Ich würde nun gerne erreichen, dass beim Öffnen dieser Tabelle (Tabelle2) ich immer entscheiden kann, ob ich die markierten Tabellen in eine neue Datei verschieben oder kopieren möchte. Dabei sollte ich jeweils den Dateinamen der neuen Datei und den Pfad individuell festlegen können.
Vielen Dank für jede Form von Hilfe bei der Realisierung meines Vorhabens.
Gruß
Fritz

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: per Markierung ausgew Tab. verschieben - kopie
30.06.2006 23:17:12
Frederik
Hallo Fritz,
der folgende Code sollte funktionieren. Einfach im VBA-Editor für Tabelle2 hinterlegen.
Das Programm verursacht allerdings eine Fehlermeldung wenn in Tabelle2 Blätter aufgelistet und mit x gekennzeichent sind, die nicht (mehr) vorhanden sind.
Gruß
Frederik
Option Base 1

Private Sub Worksheet_Activate()
Dim SheetOP(), file As String
Dim i, iChoice As Integer
For Each z In Range(Cells(1, 5), Cells((Range("D1").End(xlDown).Row), 5))
If UCase(z) = "X" Then i = i + 1
Next
ReDim SheetOP(i)
For i = 1 To UBound(SheetOP)
SheetOP(i) = Cells(i, 4)
Next
'Bei Wahl JA = Kopien, Nein = Verschieben
iChoice = MsgBox("Kopieren der Arbeitsblätter?", vbYesNoCancel)
If iChoice > 2 Then
Select Case iChoice
Case Is = 6
Sheets(SheetOP).Copy
Case Is = 7
Sheets(SheetOP).Move
End Select
file = Application.GetSaveAsFilename( _
filefilter:="Microsoft-Excel Arbeitsmappe (*.xls), *.xls")
If filefilter <> "" Then ActiveWorkbook.SaveAs (filesavename)
End If
End Sub

Anzeige
Fehlermeldung
01.07.2006 10:32:28
Fritz
Hallo Frederik,
beim Aktivieren der Schaltfläche Ja bzw. Nein erscheint eine Fehlermeldung.
Woran liegt das? Stelle Dir eine Beispieldatei ins Netz!
Nochmals vielen Dank für die Unterstützung!
Gruß
Fritz
https://www.herber.de/bbs/user/34782.xls
AW: Fehlermeldung
02.07.2006 01:25:17
MichaV
Hallo,
versuch mal so:


Option Explicit
Private Sub Worksheet_Activate()
    Dim SheetOP() As String, file As String
    Dim i As Integer, iChoice As Integer
    Dim z As Range
    Dim wbk As Workbook
    For Each z In Range(Cells(1, 5), Cells((Range("D1").End(xlDown).Row), 5))
        If UCase(z) = "X" Then
            On Error Resume Next
            ReDim Preserve SheetOP(UBound(SheetOP) + 1)
            If Err.Number <> 0 Then ReDim SheetOP(0)
            On Error GoTo 0
            SheetOP(UBound(SheetOP)) = z.Offset(0, -1).Text
        End If
    Next
    'Bei Wahl JA = Kopien, Nein = Verschieben
    iChoice = MsgBox("Kopieren der Arbeitsblätter?", vbYesNoCancel)
    If iChoice = vbCancel Then Exit Sub
    Set wbk = Workbooks.Add
    If iChoice = vbYes Then
        ThisWorkbook.Sheets(SheetOP).Copy Before:=wbk.Sheets(1)
    Else
        ThisWorkbook.Sheets(SheetOP).Move Before:=wbk.Sheets(1)
    End If
    file = Application.GetSaveAsFilename(filefilter:="Excel- Dateien (*.xls), *.xls")
    If file <> "FALSE" Then wbk.SaveAs (file)
End Sub


Gruß- Micha
PS: Rückmeldung wäre nett.
PPS: wo sind meine schönen Formeln geblieben? ;o)
Anzeige
AW: Funktioniert prima!
02.07.2006 09:42:31
Fritz
Hallo Micha,
die Sache funktioniert.
Besten Dank!!
Gruß
Fritz

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige