Ausschneiden u. Einfügen, nicht genug Arbeitsspeicher

[Matthias]

Hallo, 

ich habe anhängende Datei, 

möchte dort auf der Tabelle Montagefirmen, eine gewisse Anzahl von Zeilen 
ausschneiden und woanders wieder einfügen. Nun bekomme ich aber eine Fehlermeldung, 
aber erst dann, wenn ich das Makro 
Übertrag_Montagefirma()
ausgeführt habe. 

Kann da mir jemand helfen?

SG
Matthias

[Käpt'n Blaubär]

Hallo,

ich habe anhängende Datei, 

hier hängt nichts an,
- nach der Dateiauswahl dem roten Pfeil folgen
- den Button "Attachment hinzufügen" drücken
- sich über seinen Erfolg freuen

[Matthias]

Hallo, 

so ein neuer Versuch. 


  Terminplan Test Weber - Kopie.xlsm (Größe: 1,91 MB / Downloads: 14)

[Kuwer]

Hallo Matthias,

ändere mal in

      Application.CutCopyMode = True

das True in False um.

Gruß Uwe

[Matthias]

Hallo Uwe, 

habe es probiert, 
es kommt die gleiche Fehlermeldung
"zu wenig Arbeitsspeicher"
egal ob True oder False im Code steht. 

SG
Matthias

[Kuwer]

Hallo Matthias,

Du hattest aber schon nach dem Ändern auf False erst einmal die Datei gespeichert und Excel komplett geschlosen!?

Gruß Uwe

[Matthias]

Hallo, 

kann mir da niemand helfen??


SG
Matthias

[Case]

Hallo, :19:

probiere mal das "Application.CutCopyMode = False" mit in die Schleife zu nehmen: :21:

Code:

Option Explicit
Sub Uebertrag_Montagefirma()
Dim loAnz As Long, loLetzte As Long
Dim raBereich As Range, raZelle As Range
Dim lngCalc As Long
Application.ScreenUpdating = False
lngCalc = Application.Calculation
Application.Calculation = xlCalculationManual
With Worksheets("Montagefirma")
    .Range("A1:xfd" & .Cells(.Rows.Count, 1).End(xlUp).Row).Clear
End With
With Worksheets("Terminplan")
    .Columns("A:B").Hidden = False
    Set raBereich = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
    For Each raZelle In raBereich.SpecialCells(xlCellTypeVisible)
        If raZelle.Text = .Range("F6").Text Then
            raZelle.EntireRow.SpecialCells(xlCellTypeVisible).Copy
            loAnz = loAnz + 1
            With Worksheets("Montagefirma")
                loLetzte = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row
                If .Cells(1, "A") = "" Then loLetzte = 1
                .Cells(loLetzte, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                .Cells(loLetzte, "A").PasteSpecial Paste:=xlPasteFormats
            End With
        End If
        Application.CutCopyMode = False
    Next raZelle
    .Columns("A:B").Hidden = True
End With
Application.Calculation = lngCalc
MsgBox "Es wurden " & loAnz & " Sätze übertragen."
Set raBereich = Nothing
End Sub

Ich habe das Makro mal umbenannt. Umlaute können zu Problemen führen. Die "Application.Calculation" habe ich auf Manuell gesetzt und danach wieder auf den Urzustand zurück. Dürfte hier keine Rolle spielen - schadet aber auch nicht. :21:

[radagast]

Heje Excelfreunde,

so am Rande zu erwähnen: in Tabelle Monagefirma taucht 2* das Kürzel "h", für verschiedene Firmen auf. Würde Dir dafür eine andere Konstruktion empfehlen.
Bsp.: HA, HB oder MoFiID001 MoFiID002 usw.

[Matthias]

Hallo Case, 

kam heute erst zum probieren des Codes,


also ich muss mich bei dir bedanken funktioniert 

auf den ersten Tests hervorragend. 

Ich habe den alten und den neuen Code mal nebeneinander 
gestellt, 


du hast ja einiges geändert, meine Kenntnisse reichen leider nicht soweit, 
um dein Änderungen zu verstehen. 

Könntest du mir kurz, diese erläutern. 
Wäre dir dankbar. 

Schöne Grüsse
Matthias