Kopiern einer Zelle
07.02.2006 12:29:00
ThomasB
ich habe mit dem unten aufgeführten Macro ein Problem.
Bevor das Macro abschliesst solles eine Zelle in ein anders Tabellenblatt kopieren. Bei der Einzelschrittauslösung mit F8 läuft alles wunderbar. Doch wenn es alleine (automatischer Start) kommt immer ein Fehler im letzten Abschnitt das die andere Tabelle nicht gelesen werden kann. Diese Tabelle hat nur ein Blatt. Woran liegt es. Gibt es eine bessere Möglichkeit die Daten rüber zubekommen?
Mfg
Thomas
Sub tester()
' PS Makro
' Makro von Thomas aufgezeichnet
With Application ' Beschleunigungsmodul
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
On Error GoTo Ende
Dim PDat As String
PDat = Range("A2")
Dim wksZiel As Worksheet
Set wksZiel = ActiveSheet
Application.DisplayAlerts = False 'verhindert die Makrounterbrechnung
Workbooks.Open Filename:= _
"U:\Provisionen\VP´s Abrechnung\Übertrag\Monatlicher Übertrag.xls"
If Range("D4") = "" Then
Windows("Schuster.xls").Activate
Sheets("Provisionsabrechnung").Select
Range("H10").ClearContents
ElseIf Range("D4") > "0,00" Then
With wksZiel
.Range("H10").Value = Range("D4").Value
Range("D4").ClearContents
End With
End If
Windows("Monatlicher Übertrag.xls").Activate
Application.CutCopyMode = False
ActiveWorkbook.Close True
Ende:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.MaxChange = 0.001
End With
If Range("H11") <= 50 Then
Range("H11").Copy
ChDir "U:\Provisionen\VP´s Abrechnung\Übertrag"
Workbooks.Open Filename:= _
"U:\Provisionen\VP´s Abrechnung\Übertrag\Monatlicher Übertrag.xls"
Range("D4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Close True
End If
ActiveWorkbook.PrecisionAsDisplayed = True
ActiveWorkbook.Save
Application.Wait Now + TimeValue("00:00:01")
MsgBox "--> Import der Daten abgeschlossen! <--"
End Sub