Microsoft Excel

Herbers Excel/VBA-Archiv

Mappen erstellen je unterschiedlichem wert

Betrifft: Mappen erstellen je unterschiedlichem wert von: Ingo
Geschrieben am: 27.04.2015 02:27:41

Hallo Zusammen,

Ich habe eine Excel mit 4 Mappen. In Mappe 4 habe ich in Spalte AD verschiedene Gruppennummern und jetzt möchte ich für jede Gruppennummer eine neue Mappe erstellt haben und die Zeilen die die gleiche Gruppennummer haben in die jeweilige Mappe kopieren.
In Zeile 1 (Also A1 bis AD1) sind die jeweiligen Überschriften, die in jeder Mappe sein sollten.
Mappe soll am Schluss den Mappenname vom Inhalt der Spalte AD haben.

Ich habe dazu folgenden Code (der mir aber einen Fehler ausgibt) :

Sub Unterteilen()


 
Dim oDic As Object
Dim MeAr(), ArWerte
Dim A&
Dim tempCell As Range, AktuellerBereich As Range, rngFilter As Range
Dim iCalc As Integer

Set oDic = CreateObject("Scripting.Dictionary")

With Application
    iCalc = .Calculation
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    
            'Tabelle anpassen
            With ActivSheet
                'bereich anpassen, hier ohne Überschrift
                MeAr = Range("AD2", .Cells(.Rows.Count, 1).End(xlUp))
                Set AktuellerBereich = .UsedRange.Cells
                Set tempCell = .UsedRange(1, .UsedRange.Columns.Count).Offset(0, 1).Resize(2, 1) _

            
            
                For B = 1 To UBound(MeAr)
                  oDic(MeAr(B, 1)) = 0
                Next
                
                tempCell(1, 1) = "'" & .Cells(1, 1)
                ArWerte = oDic.Keys
                For A = LBound(ArWerte) To UBound(ArWerte)
                  
                  tempCell(2, 1) = "'=" & ArWerte(A)
            
                  With Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                    AktuellerBereich.Rows(1).Copy .Range(AktuellerBereich.Rows(1).Address)
                    AktuellerBereich.AdvancedFilter xlFilterCopy, tempCell, .Range( _
AktuellerBereich.Rows(1).Address)
                  End With
                Next A
                
                tempCell.Clear
                
                .Select
            
            End With

    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = iCalc
End With


End Sub

Vielen Dank für Eure Hilfe ! Gruß Ingo

  

Betrifft: AW: Mappen erstellen je unterschiedlichem wert von: Klaus M.vdT.
Geschrieben am: 27.04.2015 07:21:24

Hallo Ingo,
wenn du jetzt noch sagst, in welcher Zeile der Fehler ist, wie die Fehlermeldung ist ... und eventuell sogar eine auf das nötige reduzierte Musterdatei hochlädst ... dann bekommst du auch Hilfe!

With ActivSheet

es heisst ActiveSheet !
Gefällt mir aber gar nicht, vor allem nicht mit dem Select.
Lieber:
With Sheets("Tabelle4")
(oder wie immer deine Tabelle heisst)
und das .select ganz weglassen. Vielleicht löst das schon deinen Fehler auf?

Grüße,
Klaus M.vdT.


  

Betrifft: AW: Mappen erstellen je unterschiedlichem wert von: Klaus M.vdT.
Geschrieben am: 27.04.2015 07:23:18

                'bereich anpassen, hier ohne Überschrift
                MeAr = Range("AD2", .Cells(.Rows.Count, 1).End(xlUp))

hier fehlt der Punkt vor Range, um das ganze aufs ActiveSheet zu referenzieren. Müsste aber theoretisch trotzdem laufen, da es ohne Punkt ja automatisch aufs ActiveSheet verweist. Ist aber unsauber.

Grüße,
Klaus M.vdT.


  

Betrifft: AW: Mappen erstellen je unterschiedlichem wert von: Ingo
Geschrieben am: 27.04.2015 10:28:20

Hallo Klaus,

vielen Dank für deine Antwort. Die Fehlermeldung kommt in Zeile:

Set tempCell = .UsedRange(1, .UsedRange.Columns.Count).Offset(0, 1).Resize(2, 1)

Es ist : Laufzeitfehler 450 : Falsche Anzahl an Argumenten oder ungültige Zuweisung einer Eigenschaft.

Grüße Ingo


  

Betrifft: AW: Mappen erstellen je unterschiedlichem wert von: Klaus M.vdT.
Geschrieben am: 27.04.2015 10:53:16

.UsedRange.Cells(1, .UsedRange.Columns.Count).Offset(0, 1).Resize(2, 1)

Grüße,
Klaus M.vdT.


 

Beiträge aus den Excel-Beispielen zum Thema "Mappen erstellen je unterschiedlichem wert "