Ausschneiden u. Einfügen, nicht genug Arbeitsspeicher
#1
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
Top
#2
Hallo,

Zitat: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
Top
#3
Hallo, 

so ein neuer Versuch.  Confused


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

ändere mal in
      Application.CutCopyMode = True
das True in False um.

Gruß Uwe
Top
#5
Hallo Uwe, 

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

SG
Matthias
Top
#6
Hallo Matthias,

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

Gruß Uwe
Top
#7
Hallo, 

kann mir da niemand helfen??


SG
Matthias
Top
#8
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:
Top
#9
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.
Vielen Dank
--Janosch
                                                     
Excel  2019 (64bit)  Win 10 Pro (64bit)                              
Top
#10
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
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste