AW: Kopieren und ersetzten
01.05.2021 23:40:03
Alexander
wir haben das bis jetzt gebastelt , ist zwar mit zwischen kopieren aber es funktioniert. Vielleicht hat jemand ja nochmal eine "bessere" Lösung
Sub kaufundverkauf()
If Cells(2, 10) = "Alex" Then
Worksheets("Transfermarkt").Range("H3:I3").Copy
Worksheets("Alex_ausgaben").Cells(Worksheets("Alex_ausgaben").Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Worksheets("Transfermarkt").Range("j3:k3").Copy
Worksheets("Alex_Einnahmen").Cells(Worksheets("Alex_einnahmen").Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets("Transfermarkt").Range("H3:K3").Copy Worksheets("Alex").Range("A44")
Worksheets("Alex").Activate
Worksheets("Alex").Range("a4:a21").Select
Selection.Replace What:=Cells(44, 3).Value, Replacement:=Cells(44, 1).Value
Worksheets("Transfermarkt").Activate
Range("m2:p21").Calculate
MsgBox (" Alex hat " & Range("H3") & " gekauft und dafür " & Range("j3") & " verkauft")
Else
Worksheets("Transfermarkt").Range("H3:I3").Copy
Worksheets("Danny_ausgaben").Cells(Worksheets("Danny_ausgaben").Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Worksheets("Transfermarkt").Range("j3:k3").Copy
Worksheets("Danny_Einnahmen").Cells(Worksheets("Danny_einnahmen").Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Worksheets("Transfermarkt").Range("H3:K3").Copy Worksheets("Danny").Range("A44")
Worksheets("Danny").Activate
Worksheets("Danny").Range("a4:a21").Select
Selection.Replace What:=Cells(44, 3).Value, Replacement:=Cells(44, 1).Value
Worksheets("Transfermarkt").Activate
Range("r2:u21").Calculate
MsgBox (" Danny hat " & Range("H3") & " gekauft und dafür " & Range("j3") & " verkauft")
End If
End Sub