Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Copy - Paste

Forumthread: Copy - Paste

Copy - Paste
12.08.2004 18:39:39
Rosenwasser
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
Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Copy - Paste
Ramses
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
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige