Microsoft Excel

Herbers Excel/VBA-Archiv

Copy - Paste

Betrifft: Copy - Paste von: Rosenwasser
Geschrieben am: 12.08.2004 18:39:39

Hallo experts,

Kann jemand mein code (wass langsam lauft) etwas eleganter anpassen??


CODE:

Sub Omzetten_van_L1()
    
    Application.StatusBar = "Export L1.gbm to L1.xls..."
    Application.ScreenUpdating = False
    Workbooks.OpenText Filename:=Range("z1") & "\L1*.gbm", Origin:=xlWindows, StartRow _
        :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:="_", FieldInfo:=Array(Array(1, 1 _
        ), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1))
                    z = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Rows(z & ":" & z).Delete
    Dim lastCell        As Range
Dim intDifferenz    As Integer
Dim iRow            As Integer
Dim intSteps        As Integer
Dim i               As Integer
    Set lastCell = Cells(Rows.Count, 2).End(xlUp)
    iRow = lastCell.Row
    'Alle Datumreihen löschen
    Do While IsDate(Cells(iRow, 2))
        Rows(iRow).Delete
        iRow = iRow - 1
    Loop

    'Fehlende Reihen bis '0' anfügen
    intDifferenz = Cells(iRow, 2) - Cells(iRow - 1, 2)
    intSteps = Abs(Cells(iRow, 2) / intDifferenz)
    For i = 1 To intSteps
        Cells(iRow + i, 2) = Cells(iRow + i - 1, 2) + intDifferenz
    Next
    Call Omzetten_van_punt
    Cells.Select
    Workbooks.Open Filename:="C:\GBM\Gbm-Data.Xls"
    Sheets("  L1  ").Select
    Range("A1").Select
    Cells.Select
    ActiveSheet.Paste
    Range("A1").Select
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Range("E2").Select
    Range("E2").Cut Destination:=Range("D2")
    ActiveWorkbook.SaveAs Filename:="C:\GBM\L1.xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    Columns("B:D").Select
    Selection.Copy
    Windows("GBM.xls").Activate
    Sheets("Data").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
Range("C2").Select
    Selection.Copy
    Range("X1").Select
    ActiveSheet.Paste
    Range("A3:C2000").Select
    Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("A3").Select
    Windows("L1.xls").Activate
    ActiveWorkbook.Close
    Kill "C:\GBM\L1.xls"
    Range("A1").Select
    Application.ScreenUpdating = True
    Application.StatusBar = False
End Sub


Danke
  


Betrifft: AW: Copy - Paste von: Ramses
Geschrieben am: 12.08.2004 19:43:55

Hallo



Bischen viel verlangt aus dem ganzen Zeug schlau zu werden ;-)
Da weiss niemand was nötig ist und was nicht.
Kannst du nicht bei dem nachfragen, der dir die beiden Schleifen geschrieben hat ?


Sorry,... da müssen mehr Angaben her.


Gruss Rainer