Anzeige
Archiv - Navigation
468to472
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
468to472
468to472
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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

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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige