makro braucht zu lange...??

Question

hallo erst ein mal...!
ich habe ein problem und zwar mein makro das ich geschrieben habe
braucht zu lange um die daten zu verarbeiten.
hat vieleicht jemand eine idee um es ander umzusetzen...?
danke schon mal !!!!!!!


Sub Verdecktes_Oeffnen()
Dim strDateiPfad As String, strAktuell As String
strDateiPfad = "I:\Terminliste\Terminliste_neu.xls"
strAktuell = ActiveWorkbook.Name
Application.ScreenUpdating = False
Workbooks.Open Filename:=strDateiPfad
Workbooks(strAktuell).Activate
Application.ScreenUpdating = True
Sheets("Werte").Select
Range("P27:AF27").Select
Selection.Copy
Windows("Terminliste_neu.xls").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim Loletzte As Long
Loletzte = IIf(IsEmpty(Range("D1504")), Range("D1504").End(xlUp).Row + 1, 1504)
Cells(Loletzte, 2) = Range("A1").Value
Cells(Loletzte, 3) = Range("B1").Value
Cells(Loletzte, 4) = Range("C1").Value
Cells(Loletzte, 5) = Range("D1").Value
Cells(Loletzte, 6) = Range("E1").Value
Cells(Loletzte, 7) = Range("F1").Value
Cells(Loletzte, 8) = Range("G1").Value
Cells(Loletzte, 9) = Range("H1").Value
Cells(Loletzte, 10) = Range("I1").Value
Cells(Loletzte, 11) = Range("J1").Value
Cells(Loletzte, 12) = Range("K1").Value
Cells(Loletzte, 13) = Range("L1").Value
Cells(Loletzte, 14) = Range("M1").Value
Cells(Loletzte, 15) = Range("N1").Value
Cells(Loletzte, 16) = Range("O1").Value
Cells(Loletzte, 17) = Range("P1").Value
Cells(Loletzte, 18) = Range("Q1").Value
Range("A1").ClearContents
Range("B1").ClearContents
Range("C1").ClearContents
Range("D1").ClearContents
Range("E1").ClearContents
Range("F1").ClearContents
Range("G1").ClearContents
Range("H1").ClearContents
Range("I1").ClearContents
Range("J1").ClearContents
Range("K1").ClearContents
Range("L1").ClearContents
Range("M1").ClearContents
Range("N1").ClearContents
Range("O1").ClearContents
Range("P1").ClearContents
Range("Q1").ClearContents
End Sub

Answer 1

Hallo Chris,

ungetestet
Option Explicit

Sub Verdecktes_Oeffnen()
Dim strDateiPfad As String, strAktuell As String
Dim Loletzte As Long
strDateiPfad = "I:\Terminliste\Terminliste_neu.xls"
strAktuell = ActiveWorkbook.Name
Application.ScreenUpdating = False
Workbooks.Open Filename:=strDateiPfad
Workbooks(strAktuell).Activate
Application.ScreenUpdating = True
Sheets("Werte").Select
Range("P27:AF27").Copy
With Workbooks("Terminliste_neu.xls").Worksheets("???")
.Range("A1").PasteSpecial Paste:=xlPasteValues
Loletzte = IIf(IsEmpty(.Range("D1504")), .Range("D1504").End(xlUp).Row + 1, 1504)
.Range(.Cells(Loletzte, 2), .Cells(Loletzte, 18)) = .Range("A1:Q1").Value
.Range("A1Q1").ClearContents
End With
End Sub

Gruß Hajo

Answer 2

Danke für deine schnelle Antwort...!!!
Es hat geklapt,die berechnung ist richtig schnell geworden...!!
Danke noch mal.
gruß chris022