Oh vielen Dank schon mal! Jetzt ist es aber so, dass ich erstens mal schnell Senke und Quelle vertauscht habe, sonst wäre der Code genau anders herumgelaufen. War aber gar kein Problem. Sieht dann so aus
Set wkbSenke = ThisWorkbook
Set wkbQuelle = Workbooks.Open(c_sPath & BearbZ & ".xls")
und in Zeile 47: wkbQuelle.Close SaveChanges:=True
Und ich habe ein riesen Problem. Das Ganze würde ja funktionieren, aber die zu kopierenden Bereiche sind bereits mit einem VBA-Code hinterlegt. Es handelt sich um eine Art Bewertung in der zwischen D und H immer nur ein x gesetzt werden darf. Diese x hätte ich jetzt eben gerne kopiert, doch das verträgt sich anscheinend nicht mit dem VBA-Code, weil er mir nun alle Zellen dann mit x auffüllt. Was mach ich denn jetzt?
Der Code eines jeden Tabellenblatts sieht so aus:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With Target
OnChange1 Target, .Row, .Column, .Value
OnChange2 Target, .Row, .Column, .Value
End With
Application.EnableEvents = True
End Sub
Private Function OnChange1(Target As Range, R&, C&, V)
Dim NichtLeer As Boolean, Wert#
On Error Resume Next
Select Case R
Case Is > 16, Is < 4
Exit Function
End Select
Select Case C
Case Is > 8, Is < 4
Exit Function
End Select
If V <> "" Then
Range(Cells(R, 4), Cells(R, 8)).ClearContents
Target.Value = "x"
End If
End Function
Private Function OnChange2(Target As Range, R&, C&, V)
Dim rng As Range, sumCell As Range
On Error Resume Next
Set sumCell = Cells(R, 10)
If R < 4 And R < 16 Or V = "" Then
sumCell = ""
Exit Function
End If
Select Case C
Case Is > 8, Is < 4: Exit Function
End Select
Set rng = Range(Cells(R, 4), Cells(R, 8))
rng.ClearContents
Target.Value = "x"
sumCell = (8 - C) * Cells(R, 3) 'Summe
End Function
|