[Bloemche]

Liebe Excel-VBA-Virtuosen,

ich bräuchte bitte eure Hilfe

Grundsätzlich soll eine kompletts externes Excel-Arbeitsblatt (Range 1:65536) in ein definiertes Arbeitsblatt einer anderen Excel-Datei kopiert/eingefügt werden. Dann werden vier leere Spalten eingefügt und durch Copy/Paste mit Inhalt gefüllt. Datenfilter dazu und fertig. Dieses Makro soll dann auf einem weiteren Arbeitsblatt mit einem anklickbaren Button verbunden und durch nen Klick ausgelöst werden.

Mit dem Excel-Makro-Recorder habe ich folgenden Arbeitsablauf aufgenommen:

Code:

Sub COSMIC()

Code:

[align=left]'
[align=left]' COSMIC Rohdaten importieren
' Dieses Makro importiert die COSMIC Rohdaten
'
'
   Range("A1").Select
   With ActiveSheet.QueryTables.Add(Connection:=Array( _
       "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=L:\FRAEH\_EH_Stab_Teams\Stemper\Qualitätsdatenbank1.xls;M" _
       , _
       "ode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database P" _
       , _
       "assword="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk " _
       , _
       "Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OL" _
       , _
       "EDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
       ), Destination:=Cells)
       .CommandType = xlCmdTable
       .CommandText = Array("Sheet1$")
       .Name = "Qualitätsdatenbank1"
       .FieldNames = True
       .RowNumbers = False
       .FillAdjacentFormulas = False
       .PreserveFormatting = False
       .RefreshOnFileOpen = True
       .BackgroundQuery = True
       .RefreshStyle = xlInsertDeleteCells
       .SavePassword = False
       .SaveData = True
       .AdjustColumnWidth = True
       .RefreshPeriod = 0
       .PreserveColumnInfo = True
       .SourceDataFile = "L:\FRAEH\_EH_Stab_Teams\Stemper\Qualitätsdatenbank1.xls"
       .Refresh BackgroundQuery:=False
   End With
   Columns("B:B").Select
   Selection.Insert Shift:=xlToRight
   Columns("C:C").Select
   Selection.Insert Shift:=xlToRight
   Columns("D:D").Select
   Selection.Insert Shift:=xlToRight
   Selection.Insert Shift:=xlToRight
   ActiveWindow.ScrollColumn = 2
   ActiveWindow.ScrollColumn = 3
   ActiveWindow.ScrollColumn = 4
   ActiveWindow.ScrollColumn = 5
   ActiveWindow.ScrollColumn = 6
   ActiveWindow.ScrollColumn = 7
   ActiveWindow.ScrollColumn = 8
   ActiveWindow.ScrollColumn = 9
   ActiveWindow.ScrollColumn = 10
   ActiveWindow.ScrollColumn = 11
   Columns("M:P").Select
   Selection.Copy
   ActiveWindow.ScrollColumn = 10
   ActiveWindow.ScrollColumn = 9
   ActiveWindow.ScrollColumn = 8
   ActiveWindow.ScrollColumn = 7
   ActiveWindow.ScrollColumn = 6
   ActiveWindow.ScrollColumn = 5
   ActiveWindow.ScrollColumn = 4
   ActiveWindow.ScrollColumn = 3
   ActiveWindow.ScrollColumn = 2
   ActiveWindow.ScrollColumn = 1
   Range("B1").Select
   Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=False
   Range("A1").Select
   Application.CutCopyMode = False
   Selection.AutoFilter
End Sub[/align]

Leider funktioniert das nur unzureichend. Ich bekomme immer einen Laufzeitfehler 1004 angezeigt. Hat jemand nen Tip oder die Lösung? Bin was das angeht absoluter Laie und dementsprechend hilflos

[/align]