Dringend Übertrag aus 2.Excel Datei

Question

Hallo @ all,

hab ein Problem.

Ich habe drei Excel Dateien
- Erfassung
- Daten
- Auswertung
Zuvor waren es nur 2 Dateien musste diese aber splitten, da mir die Tabellen beim Speicher immer abgestürtst sind!

Ein war 20MB die andere 31MB groß.
Habe die Codes soweit angepasst, jedoch hab ich jetzt nen Haken im Code der Tabelle Auswertung.

Und zwar, im Modul4 beim Übertrag von "Daten" nach "Auswertung".
(Makro wird in der Datei "Auswertung" im gewünschten Monat z.B. Nov. mit "Strg+M" gestartet)

Dort gibt er mir einen Debugg "Laufzeitfehler 9" in Zeile 23 "Sheets(Name).select"
Denke das es damit zusammen hängt das er jetzt auf die Tabelle "Daten" zugreifen soll und nicht die Werte aus der selben Datei ziehen kann.

Weiß aber leider nicht wie ich das umschreiben muss, dass das funzt.
Habt Ihr ne Lösung?
Brauche das dringend, da ich den Monatsabschluss fertig machen muss.

Hier die Dateien:

Daten
Auswertung

Danke im Vorraus
MfG Benjamin

Answer 1

hi benji :-)

Workbooks("Mappe1").Worksheets(Name).Select

wobei eine selection hier unnoetig ist,aber wahrscheinlich dein ganzer code so aufgebaut ist :-)))

gruss nighty

Answer 2

Hi Nighty,

Leider haut das auch nicht hin!
Has so übernommen wie du geschrieben hast, und auch Mappe1 durch Zieldatei ersetzt, geht auch nicht.

Und nu?

Gruß benjamin

Answer 3

hi benji :-))

dann poste mal deinen code :-))

gruss nighty

Answer 4

Hey Nighty,

hier ist er:
Sub Pal_ab_Jul_09()
'
' Makro1 Makro
' Makro am 02.06.2009 von bauer aufgezeichnet
'

'
Dim Monat
Monat = Array("", "Jan", "Feb", "Mrz", "Apr", "Mai", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Dez")
Name = ActiveSheet.Name

ActiveSheet.Unprotect Password:=""

Mon = Left(Name, 3)
Jah = Val(Right(Name, 2)) + 2000
For i = 1 To 12
If Mon = Monat(i) Then Mon_z = i
Next i
letzte_Zeile_a = Range("A65536").End(xlUp).Row
letzte_Zeile = Range("M65536").End(xlUp).Row 'geändert
If letzte_Zeile_a > letzte_Zeile Then letzte_Zeile = letzte_Zeile_a
Range("A4:V" & letzte_Zeile).Select 'geändert
Selection.Delete Shift:=xlUp
Datum_begin = DateSerial(Jah, Mon_z, 1)
Datum_ende = DateSerial(Jah, Mon_z + 1, 0)

Windows("Hst-Schenker_EuroPal.Pool_Daten.xls").Activate
Sheets("Pal.Ausgang").Select
letzte_Zeile = Range("A65536").End(xlUp).Row
Range("A3:L" & letzte_Zeile).Select 'geändert
Application.CutCopyMode = False
Selection.Copy
Workbooks("Mappe1").Worksheets(Name).Select
Range("A4").Select
ActiveSheet.Paste

letzte_Zeile_a = Range("A65536").End(xlUp).Row 'verschoben

Range("K4:K" & letzte_Zeile_a).Select 'Neu Anfang
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft 'Neu Ende

Windows("Hst-Schenker_EuroPal.Pool_Daten.xls").Activate
Sheets("Pal.Eingang").Select
letzte_Zeile = Range("A65536").End(xlUp).Row
Range("A3:L" & letzte_Zeile).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(Name).Select
Range("M4").Select 'geändert
ActiveSheet.Paste

letzte_Zeile = Range("M65536").End(xlUp).Row 'geändert
If letzte_Zeile_a > letzte_Zeile Then letzte_Zeile = letzte_Zeile_a
For i = letzte_Zeile To 4 Step -1
If Range("A" & i).Value > Datum_ende Or Range("A" & i).Value < Datum_begin Then
Range("A" & i & ":K" & i).Select 'geändert
Selection.Delete Shift:=xlUp
End If
If Range("M" & i).Value > Datum_ende Or Range("M" & i).Value < Datum_begin Then 'geändert
Range("M" & i & ":x" & i).Select 'geändert
Selection.Delete Shift:=xlUp
End If
Next i


' Range("Y2").Select
' ActiveCell.FormulaR1C1 = "=SUMIF(R[39]C[-14]:K,""München"",R[39]C[-18]:G)"
' Range("Y2").Select
' ActiveCell.FormulaR1C1 = _
' "=SUMIF(R[39]C[-14]:R[398]C[-14],""München"",R[39]C[-18]:R[398]C[-18])"
' Range("Z2").Select
' ActiveCell.FormulaR1C1 = _
' "=SUMIF(R[39]C[-2]:R[398]C[-2],""MHM"",R[39]C[-7]:R[398]C[-7])"
' Range("Z3").Select
' ActiveWindow.SmallScroll ToRight:=-6
Range("A1:E1").Select
ActiveCell.FormulaR1C1 = "=SUMME-R[1]C[24]"
Range("A1:E1").Select
ActiveCell.FormulaR1C1 = "=SUM(R[3]C[6]:R[399]C[6])"
Range("S1:V1").Select
ActiveCell.FormulaR1C1 = "=SUM(R[3]C:R[399]C)"
Range("M2:V2").Select

ActiveSheet.Protect Password:=""

End Sub

Gruß Benjamin

Answer 5

hi benji :-)

der codeaufbau ist nun ein wenig uebersichtlicher
vielleicht reicht das ja jetzt schon,das du es bei bedarf selbst korrigieren kannst,zu optimieren waere noch einiges offen,aber konnte ja nicht testen

die withanweisung fordert einen vorrangestellten punkt vorraus

z.b.
Range("A1")

mit with
.Range("A1")

gruss nighty

Sub Pal_ab_Jul_09()
Dim Monat
Monat = Array("", "Jan", "Feb", "Mrz", "Apr", "Mai", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Dez")
Name = ThisWorkbook.ActiveSheet.Name
With ThisWorkbook.Worksheets(Name)
.Unprotect Password:=""
Mon = Left(Name, 3)
Jah = Val(Right(Name, 2)) + 2000
For i = 1 To 12
If Mon = Monat(i) Then Mon_z = i
Next i
letzte_Zeile_a = .Range("A65536").End(xlUp).Row
letzte_Zeile = .Range("M65536").End(xlUp).Row
If letzte_Zeile_a > letzte_Zeile Then letzte_Zeile = letzte_Zeile_a
.Range("A4:V" & letzte_Zeile).Delete Shift:=xlUp
Datum_begin = DateSerial(Jah, Mon_z, 1)
Datum_ende = DateSerial(Jah, Mon_z + 1, 0)
End With
With Workbooks("Hst-Schenker_EuroPal.Pool_Daten").Worksheets("Pal.Ausgang")
letzte_Zeile = .Range("A65536").End(xlUp).Row
.Range("A3:L" & letzte_Zeile).Select
Application.CutCopyMode = False
Selection.Copy
End With
With Workbooks("Mappe1").Worksheets(Name)
.Range("A4").Paste
letzte_Zeile_a = Range("A65536").End(xlUp).Row
.Range("K4:K" & letzte_Zeile_a).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
End With
With Workbooks("Hst-Schenker_EuroPal.Pool_Daten").Worksheets("Pal.Eingang")
letzte_Zeile = .Range("A65536").End(xlUp).Row
.Range("A3:L" & letzte_Zeile).Select
Application.CutCopyMode = False
Selection.Copy
.Range("M4").Paste
letzte_Zeile = .Range("M65536").End(xlUp).Row
If letzte_Zeile_a > letzte_Zeile Then letzte_Zeile = letzte_Zeile_a
For i = letzte_Zeile To 4 Step -1
If .Range("A" & i).Value > Datum_ende Or .Range("A" & i).Value < Datum_begin Then
.Range("A" & i & ":K" & i).Delete Shift:=xlUp
End If
If .Range("M" & i).Value > Datum_ende Or .Range("M" & i).Value < Datum_begin Then
.Range("M" & i & ":x" & i).Delete Shift:=xlUp
End If
Next i
.Range("A1:E1").FormulaR1C1 = "=SUMME-R[1]C[24]"
.Range("A1:E1").FormulaR1C1 = "=SUM(R[3]C[6]:R[399]C[6])"
.Range("S1:V1").FormulaR1C1 = "=SUM(R[3]C:R[399]C)"
.Protect Password:=""
End With
End Sub

Answer 6

Hey Nighty,

danke für die Arbeit, jedoch funzt es net!
Debugg = Fett gedrucktes

Und ist das beim 2. With richtig, dass das "With Workbooks("Mappe1").Worksheets(Name)"
Mappe1 richtig ist?Oder muss da die Zieldatei rein?

Sub Pal_ab_Jul_09()
Dim Monat
Monat = Array("", "Jan", "Feb", "Mrz", "Apr", "Mai", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Dez")
Name = ThisWorkbook.ActiveSheet.Name
With ThisWorkbook.Worksheets(Name)
.Unprotect Password:=""
Mon = Left(Name, 3)
Jah = Val(Right(Name, 2)) + 2000
For i = 1 To 12
If Mon = Monat(i) Then Mon_z = i
Next i
letzte_Zeile_a = .Range("A65536").End(xlUp).Row
letzte_Zeile = .Range("M65536").End(xlUp).Row
If letzte_Zeile_a > letzte_Zeile Then letzte_Zeile = letzte_Zeile_a
.Range("A4:V" & letzte_Zeile).Delete Shift:=xlUp
Datum_begin = DateSerial(Jah, Mon_z, 1)
Datum_ende = DateSerial(Jah, Mon_z + 1, 0)
End With
With Workbooks("Hst-Schenker_EuroPal.Pool_Daten").Worksheets("Pal.Ausgang")
letzte_Zeile = .Range("A65536").End(xlUp).Row
.Range("A3:L" & letzte_Zeile).Select
Application.CutCopyMode = False
Selection.Copy
End With
With Workbooks("Mappe1").Worksheets(Name)
.Range("A4").Paste
letzte_Zeile_a = Range("A65536").End(xlUp).Row
.Range("K4:K" & letzte_Zeile_a).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
End With
With Workbooks("Hst-Schenker_EuroPal.Pool_Daten").Worksheets("Pal.Eingang")
letzte_Zeile = .Range("A65536").End(xlUp).Row
.Range("A3:L" & letzte_Zeile).Select
Application.CutCopyMode = False
Selection.Copy
.Range("M4").Paste
letzte_Zeile = .Range("M65536").End(xlUp).Row
If letzte_Zeile_a > letzte_Zeile Then letzte_Zeile = letzte_Zeile_a
For i = letzte_Zeile To 4 Step -1
If .Range("A" & i).Value > Datum_ende Or .Range("A" & i).Value < Datum_begin Then
.Range("A" & i & ":K" & i).Delete Shift:=xlUp
End If
If .Range("M" & i).Value > Datum_ende Or .Range("M" & i).Value < Datum_begin Then
.Range("M" & i & ":x" & i).Delete Shift:=xlUp
End If
Next i
.Range("A1:E1").FormulaR1C1 = "=SUMME-R[1]C[24]"
.Range("A1:E1").FormulaR1C1 = "=SUM(R[3]C[6]:R[399]C[6])"
.Range("S1:V1").FormulaR1C1 = "=SUM(R[3]C:R[399]C)"
.Protect Password:=""
End With
End Sub
in meiner anfrage sind ja beide Dateien hochgeladen, kannst du es da mit checken?
Oder hast du das 2007ner zum testen nicht?

Gruß Benjamin

Answer 7

Guten Morgen,
hat da jemand noch ne Idee wie ich das wieder hinbekomme?

MfG Benjamin

Answer 8

hi benji :-)

probier mal :-)

zu 1)

bin vielleicht von der falschen instanz ausgegangen

ersetze

With Workbooks("Hst-Schenker_EuroPal.Pool_Daten").Worksheets("Pal.Ausgang")

durch

With Windows("Hst-chenker_EuroPal.Pool_Daten.xls").Worksheets("Pal.Ausgang")

zu 2)

von deinem code wurde der name uebernommen,sollte den geforderten mappennamen haben,Mappe1 durch deinen mappennamen ersetzen

With Workbooks("Mappe1").Worksheets(Name)

gruss nighty

Answer 9

Haut leider immer noch nicht hin ich weiß auch nicht!

Ich glaub ich muss es wieder zurück klöppeln!
Ich bekomme es aber auch nicht hin eine neue Version mit dem MacroRecorder aufzunehmen.

...

gibst da noch was was wir/ich übersehen haben?


MfG Benjamin

Answer 10

hi benji :-)

schick mir musterdateien,mit aussagefaehigen betreff,einfach paar dummydaten rein :-))

und eine erklaerung was so gemacht werden sollte,am besten schrittweise

oberley@t-online.de

gruss nighty