Fehler beim Kopieren - Makrofehler?
31.07.2007 08:44:15
Dicky
Ich habe folgendes Problem:
Ich lese Textdateien (Schnittstellendaten) aus einer Datei in Excel ein, Filtere daten und Kopiere diese in eine andere Exceltabelle. Je Datumstag gibt es eine Datei. Mein Makro funktioniert bei den ersten 6-7 Tagen einwandfrei, bricht aber jeweils am 7-8. Tag ab beim Einfügen in die 2. Tabelle mit der Fehlermeldung Laufzeitfehler 1004 - Bereich Kopieren und Einfügen haben unterschieldiche Größe.
Die Dateien sind jedoch identisch. Das Makro lautet wie folgt (sorry ist serh umständlich aufgebaut, bin kein Profi :(
Sub aufruf_Datei()
' aufruf_Datei Makro
' Makro am 12.07.2007 von B3 aufgezeichnet
Dim vondat As String
Dim bisdat As String
Dim Jahr As String
Dim N As Integer
Dim Zieldat As String
Dim i As Integer
Dim M As Integer
Range("c9").Select
vondat = Selection
'MsgBox (Selection)
Range("c11").Select
bisdat = Selection
Range("c6").Select
Jahr = Selection
Range("c9").Select
Selection.Copy
' kopieren des Felder von.... und erweitern auf alle Tage des Monats
Application.CutCopyMode = False
Selection.Copy
Sheets("Dateisel").Select
Range("C3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.AutoFill Destination:=Range("C3:C33"), Type:=xlFillDefault
For i = 3 To 33
Zieldat = Sheets("Dateisel").Cells(i, 3)
If Dir("D:\Lange\" & 2007 & "\" & Zieldat & ".DIF") "" Then
'öffnen der Schnittstellendatei
Workbooks.OpenText Filename:="D:\Lange\" & 2007 & "\" & Zieldat & ".DIF", Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, _
1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), _
Array(15 _
, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1) _
, _
Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), _
Array( _
28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, _
1), _
Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), _
Array( _
41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, _
1), _
Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), _
Array( _
54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, _
1), _
Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65, 1), Array(66, 1), _
Array( _
67, 1), Array(68, 1), Array(69, 1))
Cells.Select
Selection.AutoFilter
ActiveWindow.ScrollColumn = 16
Selection.AutoFilter Field:=25, Criteria1:="=26", Operator:=xlOr, _
Criteria2:="=52"
Rows("1:800").Copy
Selection.Copy
Windows("Uebernahme_Schnittstelle").Activate
Sheets("daten").Select 'fügt in die erste Zeile ein, in der im Feld a*
'nichts mehr steht
Range("a1").Activate
ActiveCell.End(xlDown).Select
Selection.Offset(1, 0).Activate
ActiveSheet.Paste 'hier kommt die Fehlermeldung
Windows(Zieldat & ".DIF").Activate
Application.CutCopyMode = False
ActiveWorkbook.Close SaveChanges:=False
GoTo weitermachen
End If
weitermachen:
Next i
End Sub
Danke für Eure Hilfe
Frank