Excel 2010 Makro verschieben

Furble · 2. September 2013

Hallo,

ich würde gerne die Makros in den Modulen Modul1, Modul2, Modul3 und Modul4 in die Tabelle1 meiner Excel Arbeitsmappe verschieben und zum Laufen kriegen. Wenn ich einfach den Code kopiert habe und eines der Makros ausführen möchte. welches sich auf eine Lasche (sagen wir Tabelle3) bezieht, kommt bei mir immer der Fehler 400.

Vielen Dank im Voraus!

Meerix · 2. September 2013

Moin,

es könnte hilfreich sein, wenn du das Makro posten könntest damit man es etwas mehr nachvollziehen kann.

Furble · 2. September 2013

Makro in Modul1:

Code:

Public Sub Makro_Minor()
'
' Makro_Minor Makro
'

'
Application.ScreenUpdating = False
    Sheets("VORLAGE Fabian").Select
   
    Range("CK20:CW299").Select
    Selection.Copy
    Sheets("minor").Select
    Range("CK20").Select
    ActiveSheet.Paste
    Sheets("VORLAGE Fabian").Select
    Sheets("minor").Select
    Range("N24:O299").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("CT24").Select
    ActiveSheet.Paste
    Range("AD24:AE299").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.LargeScroll Down:=1
    Range("CM24").Select
    ActiveSheet.Paste
    Sheets("VORLAGE Fabian").Select
    Range("CL41").Select
    Range("L24:M299").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("minor").Select
    Range("L24").Select
    ActiveSheet.Paste
    Sheets("VORLAGE Fabian").Select
    Range("AD24:AE299").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("minor").Select
    Range("AD24").Select
    ActiveSheet.Paste
    Range("AD20").Select
    Sheets("VORLAGE Fabian").Select
    Range("K3:P4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("minor").Select
    Range("K3").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Modul2:

Code:

Public Const F0006 = "Funktion nur bei den BKW-Blättern zulässig"
Public Const F0007 = "Positionsart B oder P eintragen"
Public Const F0008 = "Einbaumenge muß Wert > 0 sein"
Public Const F0009 = "Preiskennzeichen C / F oder D zulässig"
Dim b_ze()
Dim ze, b
Sub Starten_cmdFormatieren()
    Sheets("initial").Select
    Range("L24:M24").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AD24:AE24").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("minor").Select
    Range("L24:M24").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AD24:AE24").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("allgemein").Select
    ActiveWindow.SmallScroll Down:=-12
    Range("A1").Select
Application.ScreenUpdating = False
Sheets("initial").Select
    If Range("B1") = "Version 1.0 A" Then
        Else
            Mldg = "Sie greifen auf eine ältere BKW-Tabelle zu." & Chr(13) & " Bitte Update auf Version 1.0 A durchführen !!! "
            Stil = vbExclamation
            Title = "Meldung"
            Ergebnis = MsgBox(Mldg, Stil, Title)
            Exit Sub
        End If
        
        If Range("A1") = "exbkw" Or Range("A1") = "BKW" Then
            Ergebnis = MsgBox(F0006, vbOKOnly, "Code No. 0006")
            Exit Sub
        End If
        
        ze = 23: sp = 3
        If IsEmpty(Cells(23, 3)) Then
            MsgBox ("Leer !!!")
            Exit Sub
        End If
        
        If ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
        End If
        
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 3
    Range("c1:e21").Select
        
    ReDim b_ze(1 To 500): b = 0 'Markierung Stoll 230 in 500 geändert
    Do While Not IsEmpty(Cells(ze, sp))
        G = UCase(Cells(ze, 3))
        Cells(ze, 3) = G
        If Cells(ze, sp) = "P" Then
            Cells(ze, 7) = "=roundup(r[0]c[80],0)"
                G1 = UCase(Cells(ze, 11))
                Cells(ze, 11) = G1
                If G1 = "C" Or G1 = "F" Or G1 = "D" Or G1 = "" Then
                    Else
                        Ergebnis = MsgBox(F0009, vknurok, "Code No. 0009")
                        Cells(ze, 11).Activate
                        Exit Sub
                End If
            
        ElseIf Cells(ze, sp) = "B" Then
            If Cells(ze, 6) = 0 Or Cells(ze, 6) = "" Then
                Ergebnis = MsgBox(F0008, vknurok, "Code No. 0008")
                Cells(ze, 6).Activate
                Exit Sub
            End If
            b = b + 1
            b_ze(b) = ze
        
        Else
            Ergebnis = MsgBox(F0007, vknurok, "Code No. 0007")
            Cells(ze, 3).Activate
            Exit Sub
        End If
            
        ze = ze + 1
    Loop  'Until IsEmpty(Cells(ze, sp))
        If b > 0 Then
            ReDim Preserve b_ze(1 To b)
        End If
    ze = ze - 1
'*********************************************************************************
    With Range(Cells(23, 3), Cells(ze, 87))
        
        With .Interior
            .ColorIndex = xlAutomatic
            .Pattern = xlSolid
        End With
        
        With .Font
            .Name = "Arial"
            .FontStyle = "Regular"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlNone
            .ColorIndex = xlAutomatic
        End With
        
        If ze > 23 Then
        With .Borders(xlInsideHorizontal)
        .Weight = xlHairline
        .ColorIndex = 11
        End With
        End If
        
        With .Borders(xlEdgeBottom)
            .Weight = xlHairline
            .ColorIndex = 11
        End With
        
        With .Borders(xlInsideVertical)
        .Weight = xlHairline
        .ColorIndex = 11
        End With
    
    End With
    
    With Range(Cells(23, 2), Cells(ze, 2))
        With .Interior
            .ColorIndex = 20
            .Pattern = xlSolid
        End With
        With .Borders(xlRight)
            .Weight = xlMedium
            .ColorIndex = 11
        End With
    End With
    
    For s = 15 To 21 Step 3
        With Range(Cells(23, s), Cells(ze, s)).Borders(xlRight)
            .Weight = xlMedium
            .ColorIndex = 11
        End With
    Next
    
    With Range(Cells(23, 87), Cells(ze, 87))
        With .Borders(xlLeft)
            .Weight = xlMedium
            .ColorIndex = 11
        End With
        With .Interior
            .ColorIndex = 19
            .Pattern = xlSolid
        End With
        With .Borders(xlRight)
            .Weight = xlMedium
            .ColorIndex = 11
        End With
    End With
    
    For x = 1 To b
        With Range(Cells(b_ze(x), 3), Cells(b_ze(x), 86))
            With .Font
                .Name = "Arial"
                .FontStyle = "Bold"
                .Size = 10
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlNone
                .ColorIndex = 3
            End With
            With .Interior
                .ColorIndex = 40
                .Pattern = xlSolid
            End With
        End With
    Next
    
Sheets("minor").Select
    If Range("B1") = "Version 1.0 A" Then
        Else
            Mldg = "Sie greifen auf eine ältere BKW-Tabelle zu." & Chr(13) & " Bitte Update auf Version 1.0 A durchführen !!! "
            Stil = vbExclamation
            Title = "Meldung"
            Ergebnis = MsgBox(Mldg, Stil, Title)
            Exit Sub
        End If
        
        If Range("A1") = "exbkw" Or Range("A1") = "BKW" Then
            Ergebnis = MsgBox(F0006, vbOKOnly, "Code No. 0006")
            Exit Sub
        End If
        
        ze = 23: sp = 3
        If IsEmpty(Cells(23, 3)) Then
            MsgBox ("Leer !!!")
            Exit Sub
        End If
        
        If ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
        End If
        
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 3
    Range("c1:e21").Select
        
    ReDim b_ze(1 To 500): b = 0 'Markierung Stoll 230 in 500 geändert
    Do While Not IsEmpty(Cells(ze, sp))
        G = UCase(Cells(ze, 3))
        Cells(ze, 3) = G
        If Cells(ze, sp) = "P" Then
            Cells(ze, 7) = "=roundup(r[0]c[80],0)"
                G1 = UCase(Cells(ze, 11))
                Cells(ze, 11) = G1
                If G1 = "C" Or G1 = "F" Or G1 = "D" Or G1 = "" Then
                    Else
                        Ergebnis = MsgBox(F0009, vknurok, "Code No. 0009")
                        Cells(ze, 11).Activate
                        Exit Sub
                End If
            
        ElseIf Cells(ze, sp) = "B" Then
            If Cells(ze, 6) = 0 Or Cells(ze, 6) = "" Then
                Ergebnis = MsgBox(F0008, vknurok, "Code No. 0008")
                Cells(ze, 6).Activate
                Exit Sub
            End If
            b = b + 1
            b_ze(b) = ze
        
        Else
            Ergebnis = MsgBox(F0007, vknurok, "Code No. 0007")
            Cells(ze, 3).Activate
            Exit Sub
        End If
            
        ze = ze + 1
    Loop  'Until IsEmpty(Cells(ze, sp))
        If b > 0 Then
            ReDim Preserve b_ze(1 To b)
        End If
    ze = ze - 1
'*********************************************************************************
    With Range(Cells(23, 3), Cells(ze, 87))
        
        With .Interior
            .ColorIndex = xlAutomatic
            .Pattern = xlSolid
        End With
        
        With .Font
            .Name = "Arial"
            .FontStyle = "Regular"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlNone
            .ColorIndex = xlAutomatic
        End With
        
        If ze > 23 Then
        With .Borders(xlInsideHorizontal)
        .Weight = xlHairline
        .ColorIndex = 11
        End With
        End If
        
        With .Borders(xlEdgeBottom)
            .Weight = xlHairline
            .ColorIndex = 11
        End With
        
        With .Borders(xlInsideVertical)
        .Weight = xlHairline
        .ColorIndex = 11
        End With
    
    End With
    
    With Range(Cells(23, 2), Cells(ze, 2))
        With .Interior
            .ColorIndex = 20
            .Pattern = xlSolid
        End With
        With .Borders(xlRight)
            .Weight = xlMedium
            .ColorIndex = 11
        End With
    End With
    
    For s = 15 To 21 Step 3
        With Range(Cells(23, s), Cells(ze, s)).Borders(xlRight)
            .Weight = xlMedium
            .ColorIndex = 11
        End With
    Next
    
    With Range(Cells(23, 87), Cells(ze, 87))
        With .Borders(xlLeft)
            .Weight = xlMedium
            .ColorIndex = 11
        End With
        With .Interior
            .ColorIndex = 19
            .Pattern = xlSolid
        End With
        With .Borders(xlRight)
            .Weight = xlMedium
            .ColorIndex = 11
        End With
    End With
    
    For x = 1 To b
        With Range(Cells(b_ze(x), 3), Cells(b_ze(x), 86))
            With .Font
                .Name = "Arial"
                .FontStyle = "Bold"
                .Size = 10
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlNone
                .ColorIndex = 3
            End With
            With .Interior
                .ColorIndex = 40
                .Pattern = xlSolid
            End With
        End With
    Next
'*********************************************************************************
    Sheets("allgemein").Select
    Range("A1").Select
    Application.ScreenUpdating = True
End Sub

Modul3:

Code:

Public Sub Makro_Initial()
'
' Makro_Initial Makro
'

'
Application.ScreenUpdating = False
    Sheets("VORLAGE Fabian").Select
    Range("CK20:CW24").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("initial").Select
    Range("CK20").Select
    ActiveSheet.Paste
    Range("CK24").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=IF(RC[2]="""","""",RC[2]*Faktor_Initial_Real)"
    Range("CL24").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[2]="""","""",RC[2]*Faktor_Initial_Real)"
    Range("CO24").Select
    ActiveCell.FormulaR1C1 = "=IF(Initial_Spare_Parts_Check="""",RC[-2],RC[-4])"
    Range("CP24").Select
    ActiveCell.FormulaR1C1 = "=IF(Initial_Spare_Parts_Check="""",RC[-2],RC[-4])"
    Range("CR24").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[2]="""","""",RC[2]*Faktor_Initial_Real2)"
    Range("CS24").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[2]="""","""",RC[2]*Faktor_Initial_Real2)"
    Range("CV24").Select
    ActiveCell.FormulaR1C1 = "=IF(Initial_Spare_Parts_Check2="""",RC[-2],RC[-4])"
    Range("CW24").Select
    ActiveCell.FormulaR1C1 = "=IF(Initial_Spare_Parts_Check2="""",RC[-2],RC[-4])"
    Range("CK24:CW24").Select
    Selection.AutoFill Destination:=Range("CK24:CW300"), Type:=xlFillDefault
    Range("CK24:CW300").Select
    Range("L24:M300").Select
    Selection.Copy
    Range("CT24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AD24:AE300").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("CM24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("CO24:CP300").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AD24").Select
    Application.CutCopyMode = False
    Range("CO24").Select
    ActiveCell.FormulaR1C1 = "=IF(Initial_Spare_Parts_Check="""",RC[-2],RC[-4])"
    Range("CO25").Select
    Range("AD24").Select
    ActiveCell.FormulaR1C1 = "=IF(Initial_Spare_Parts_Check="""",RC[61],RC[59])"
    Range("AD25").Select
    Range("CP24").Select
    ActiveCell.FormulaR1C1 = "=IF(Initial_Spare_Parts_Check="""",RC[-2],RC[-4])"
    Range("CP25").Select
    Range("AE24").Select
    ActiveCell.FormulaR1C1 = "=IF(Initial_Spare_Parts_Check="""",RC[61],RC[59])"
    Range("AD24:AE24").Select
    Selection.AutoFill Destination:=Range("AD24:AE300"), Type:=xlFillDefault
    Range("AD24:AE300").Select
    Range("N24").Select
    Range("CV24").Select
    ActiveCell.FormulaR1C1 = "=IF(Initial_Spare_Parts_Check2="""",RC[-2],RC[-4])"
    Range("CV25").Select
    Range("L24").Select
    ActiveCell.FormulaR1C1 = "=IF(Initial_Spare_Parts_Check2="""",RC[86],RC[84])"
    Range("L25").Select
    Range("CW24").Select
    ActiveCell.FormulaR1C1 = "=IF(Initial_Spare_Parts_Check2="""",RC[-2],RC[-4])"
    Range("CW25").Select
    Range("N24").Select
    ActiveCell.FormulaR1C1 = "=IF(Initial_Spare_Parts_Check2="""",RC[85],RC[83])"
    Range("M24:N24").Select
    Range("L24:M24").Select
    Selection.AutoFill Destination:=Range("L24:M300"), Type:=xlFillDefault
    Range("L24:M300").Select
    Range("L24").Select
    Range("CW24").Select
    ActiveCell.FormulaR1C1 = "=IF(Initial_Spare_Parts_Check2="""",RC[-2],RC[-4])"
    Range("CW25").Select
    Range("M24").Select
    ActiveCell.FormulaR1C1 = "=IF(Initial_Spare_Parts_Check2="""",RC[86],RC[84])"
    Range("M24").Select
    Selection.AutoFill Destination:=Range("M24:M300"), Type:=xlFillDefault
    Range("M24:M300").Select
    Sheets("VORLAGE Fabian").Select
    Range("K3:P4").Select
    Selection.Copy
    Sheets("initial").Select
    Range("K3").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.ScreenUpdating = True
End Sub
Public Sub Master_Button()
Application.ScreenUpdating = False
Call Makro_Initial
Call Makro_Minor
Sheets("allgemein").Select
Range("O10:O11").Select
    Selection.Copy
    Range("A10").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1").Select
Application.ScreenUpdating = True
End Sub
End Sub

Modul4:

Code:

Sub Reset1()
'
' Reset1 Makro
'

'
    Range("B27:C35").Select
    Selection.ClearContents
    Range("P16").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-10]="""","""",(1+RC[-10])*RC[-12])"
    Range("P17").Select
    Range("G16").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",(1+RC[-1])*RC[-3])"
    Range("G17").Select
    Range("P17").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-10]="""","""",(1+RC[-10])*RC[-12])"
    Range("P18").Select
    Range("G17").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",(1+RC[-1])*RC[-3])"
    Range("G17").Select
    Selection.AutoFill Destination:=Range("G17:G24"), Type:=xlFillDefault
    Range("G17:G24").Select
    Range("G16:G24").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Range("R16").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-7]="""","""",(1+RC[-7])*RC[-15])"
    Range("R17").Select
    Range("L16").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",(1+RC[-1])*RC[-9])"
    Range("R17").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-7]="""","""",(1+RC[-7])*RC[-15])"
    Range("K17").Select
    ActiveCell.FormulaR1C1 = ""
    Range("L17").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",(1+RC[-1])*RC[-9])"
    Range("L17").Select
    Selection.AutoFill Destination:=Range("L17:L24"), Type:=xlFillDefault
    Range("L17:L24").Select
    Range("L16:L24").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Range("A1").Select
End Sub

Modul5:

Code:

Sub Reset_Zahlen()
'
' Makro2 Makro
'

'
Application.ScreenUpdating = False
    Sheets("initial").Select
    Range("CM24:CN999").Select
    Selection.Copy
    Range("AD24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("CT24:CU999").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("L24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("minor").Select
    Range("CM24:CN999").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AD24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("CT24:CU999").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("L24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("allgemein").Select
    Range("A1").Select
    Application.CutCopyMode = False
    Sheets("allgemein").Select
    Range("A10:A11").Select
    Selection.ClearContents
    Range("A1").Select
    Application.ScreenUpdating = True
End Sub

Der Masterbutton soll die Makros Initial und Minor ausführen (und ein paar andere Kleinigkeiten).

Die anderen Makros sollen relativ eigenständig laufen. Ziel ist es, alle Makros in die Tabelle1 zu bekommen, um sie dann nach Belieben in andere Arbeitsmappen (also andere Excel Dateien) einfügen zu können.

Meerix · 2. September 2013

Ich verstehe noch nicht so ganz was du bezwecken willst mit dem Verschieben. Du solltest doch deine Macros in ein Modul kopieren/verschieben können Bild

Oder willst du Buttons haben, welche dann das entsprechende Macro starten?

simpsonsfan · 2. September 2013

Befinden sich die Module eigentlich in der Arbeitsmappe oder in einer anderen? Falls sie das tun, weshalb willst du dann die Makros überhaupt verschieben?
Wie werden denn die Makros eigentlich aufgerufen und werden sie trotz Fehlermeldung (teilweise) ausgeführt?

Sonst wirst du mal debuggen müssen und schauen, in welcher Zeile der Fehler auftritt.

cumulonimbus8 · 2. September 2013

Brummel… DiesenMakrobcodebandwurmkanmangarnichtlesenundnachvollziehendaerkeinefürdasAugehilfreicheStrukturhat.

Sheets("VORLAGE Fabian").Select

Da lässt wohl der Recorder grüßen. Sei's drum, so lange hier ein Blatt mit Namen angesprochen wird und dieser Name nicht mehr auftritt sitzen wir in der Patsche.
(Ich habe auf die Suche nach weiteren solcher Referenzen verzichtet.)

Bitte bedenke, dass der Code der aktiv ist sich (unabhängig) auf das aktive Blatt bezieht. Verweise ich auf kein anderes (wie oben) wird der Code der in jedem Blatt XY steht genauso sein Blatt XY bedienen wie er es mit AB täte wäre das aktiv (sichtbar).

CN8

Furble · 2. September 2013

Das verstehe ich nun nicht ganz...

Ich hatte vor, eine Excel Mappe zu erstellen, die aus zwei Seiten besteht. In der ersten der beiden Seiten sollen alle Makros gespeichert sein. Das Ziel war, die Seiten Tabelle1(allgemein) und VORLAGE Fabian in ein Excel-Dokument zu kopieren, um dann in diesem die Makros auszuführen.

Wenn ich die beiden Seiten Tabelle1(allgemein) und VORLAGE Fabian in das neue Excel Dokument kopiere und dort alle Seiten mit den Namen vorhanden sind, die im Makro aufgerufen werden (z.B. initial), warum kommt es dann zu einem Fehler?

simpsonsfan · 3. September 2013

Wie gesagt, es besteht kein Grund, die Makros in Tabelle1 zu verschieben. Steck sie in Module, dann sollte das klappen.

Furble · 3. September 2013

Sie befinden sich ja bereits in Modulen... Wo sind denn Module gespeichert? Kann eine andere Excel-Datei dann auf die Module zugreifen? Was ist die Voraussetzung dafür?

Danke!

simpsonsfan · 3. September 2013

Die Module können in derselben Mappe oder in der persönlichen Makroarbeitsmappe gespeichert sein. Wo sie momentan gespeichert sind, kann ich ja nicht wissen, wenn du den Makrorekorder verwendet hast, lässt sich das dort einstellen. Jedenfalls kannst du den Code dort einfach in deine neue Arbeitsmappe kopieren, oder auch über die Exportieren-Importieren-Funktion gehen, das sollte aber eigentlich keinen Unterschied machen.

Furble · 3. September 2013

Ich möchte aber eine Vielzahl von Mappen mit einem vorbereiteten Makro bearbeiten, indem ich einfach die beiden Seiten "VORLAGEFabian" und "allgemein" hineinkopiere. Jedes mal ein makro zu importieren ist nicht erwünscht.

simpsonsfan · 3. September 2013

Naja, solange eine Arbeitsmappe geöffnet ist, kannst du deren Makromodule auch in anderen Mappen verwenden. Am einfachsten wäre bei dir evtl., die Makros in die persönliche Makroarbeitsmappe zu schieben, die ist nämlich immer auch offen (das sieht man nur nicht). Wenn du die Makros öfter verwendest, dann kannst du sie dir dann auch auf eine Symbolleiste legen.

Diese 400-Meldung taucht nämlich u.a. auf, wenn man von Makros, die in einem Tabellenblatt abgelegt sind, andere Tabellenblätter aufrufen will. Das ist hier der Fall.

Furble · 3. September 2013

Wie sieht das mit der persönlichen Arbeitsmappe aus, wenn ich das ganze auch auf einem anderen PC machen möchte?

Wie funktioniert das mit der Symbolleiste?

simpsonsfan · 3. September 2013

Das klappt dann nicht, wenn der Makro nicht auf dem anderen PC abgespeichert ist. Müsstest dann eben die Mappe kopieren. Fakt ist, Excel mault rum, wenn du das in Tabellenblätter schiebst.
Wie's mit den Symbolleisten in Excel 2010 aussieht, weiß ich nicht genau. Im Normalfall musst du halt bei den Symbolleisten->Befehle neu anordnen und dort kannst du dann eine Benutzerdefinierte Schaltfläche hinzufügen.
Und du kannst auch Makros aus einer bestimmten Arbeitsmappe ausführen, die muss dann halt immer dazu geöffnet sein.

PS: Kannst du eigentlich deinen Code in [spoiler][/spoiler] packen, dann wird der Thread hier übersichtlicher.
Und wenn du schon dabei bist, kannst du statt [quote] [code] verwenden.

Furble · 3. September 2013

Hmmm, nochmal back to basic: Ich möchte eig nur die beiden Seiten "allgemein" und "VORLAGE Fabian" in ein anderes Excel Dokument kopieren und dann die Makros ausführen, die alle möglichen anderen schon vorhanden Seiten usw. bearbeiten sollen. Und im letzten Schritt gibt es den Fehler 400. Kann man den nicht umgehen? Was wäre ein alternativer Weg?

Danke!

simpsonsfan · 3. September 2013

Probier am besten erst mal, ob es denn klappt, wenn du den Makro einfach mal aus einer anderen Datei aufrufst. Also die bestehende Mappe offen lassen, da wo die Makros in den Modulen stehen und dann in der anderen Datei unter Makros einfach mal ausführen und schauen, ob der Fehler dann nicht auftritt.

Wenn dem so wäre, fände ich es z.B. keine schlechte Idee, die personl.xls zu verwenden, die ist dann allerdings nicht auf dem anderen PC.
Du kannst natürlich auch immer deine restlichen Tabellenblätter in die schon bestehende Mappe mit den Makromodulen einfügen oder einfach die Module kopieren, was in meinen Augen auch keinen wesentlichen Mehraufwand zum Kopieren der Tabellenblätter darstellt, man muss halt kurz in den VBA-Editor. Oder du kannst im Hintergrund die Arbeitsmappe mit den Makros in Modulen offen haben und dann eben von der andern Mappe aufrufen. Sollte jedenfalls im Normalfall alles klappen.

cumulonimbus8 · 3. September 2013

Dann sage uns doch mal wo der «letzte Schritt» denn stattfindet.

Sheets("initial").Select

Wie ich oben schreib, wenns kein Blatt namens initial gibt dann gibt es eine Bauchlandung.

Ich fasse mal zusammen:
• Man kann natürlich über rechtkslick auf den Tab des Blattes dieses Kopieren, mit allem was drin ist, auch Makrocode. (Habe das noch nie gemacht, kann sein, dass das sogar mit mehreren markierten Blättern tut.)
• Ein Makro das ein Blatt persönlich anspricht (und zwar ohne Angabe einer Mappe in der Referenzierung) spricht das Blatt der aktuellen offene Mappe an, gleich wo es sich aufhält (dieses Blatt, Modul dieser Mappe, Persönliche Arbeitsmappe, Blattcode einer anderen Mappe).
• wenn da Blätter angesprochen werden die es nicht gibt dann gibt es einen Unfall.

Warum aber willst du immer diese Umstände treiben? Das hatten andere schon gefragt, auch ich tute es.
• Warum Blätter kopieren, mit Inhalten drin (neben dem Makrocode)?
• Warum beruhen die Mappen in die die Blätter sollen nicht auf einer Vorlage / Kopie einer Mappe die diese Blätter bereits enthält?
• Warum kann das {was die Makros tun} nicht von einer Persönlichen Arbeitsmappe oder von mir aus einer öffentlichen Hilfsmappe aus erledigt werden?

CN8

PS: Habt ihr keine Excel-Menschen der mal diesen Code unter Vorlage dessen worauf er sich bezieht auf das Nötigste eindampft indem mächtigere Befehle oder andere Mechanismen eingespannt werden?

PPS: Ich danke dem der das in Spoiler mir Code gegossen hat, das macht es etwas einfacher (dabei hatte ich nicht mal an so eine Maßnahme gedacht). Denn dieser Spagetticode ist in sich kaum lesbar.

Suche

Excel 2010 Makro verschieben

Furble

Lt. Commander

Meerix

Ensign

Furble

Lt. Commander

Meerix

Ensign

simpsonsfan

Captain

cumulonimbus8

Fleet Admiral

Furble

Lt. Commander

simpsonsfan

Captain

Furble

Lt. Commander

simpsonsfan

Captain

Furble

Lt. Commander

simpsonsfan

Captain

Furble

Lt. Commander

simpsonsfan

Captain

Furble

Lt. Commander

simpsonsfan

Captain

cumulonimbus8

Fleet Admiral

Ähnliche Themen