Excel - úprava kopírujícího makra

[bloom]

Ahoj, potřeboval bych poradit s makrem, které kopíruje data po změně hodnot na jiný list. To se mi podařilo sestavit, ale potřeboval bych tam ještě doladit pár věcí:
1) Chtěl bych, aby se makro spustilo automaticky ne hned po změně hodnoty v dané buňce, ale aby se spustilo až po opuštění řádku, ve kterém se změněná buňka nachází.
2) V daném souboru je umístěno makro, které po spuštění konkrétního tlačítka přidá do tabulky jeden prázdný řádek. Když se přidá nový řádek, tak se kopíruje jako změněný na nový. Rád bych, aby se přidáním řádku kopírování nespouštělo.

Dosavadní kód přikládám níže:

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)
       
    ChngRow = Target.Row

SrcRange = "A" & ChngRow & ":K" & ChngRow
Range(SrcRange).Copy
With Sheets("History").Range("A" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
End With
    Application.CutCopyMode = False
   
   Worksheets("History").Range("L" & Rows.Count).End(xlUp).Offset(1).Value = Now
Sheets("History").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Environ("username")

End Sub


Mnohokrát děkuji za jakoukoliv pomoc. bloom

[Reklama]

[cmuch]

Ad 1)
Vlož do listu z kterého se bude kopírovat.

Kód: Vybrat vše

Dim ChngRow As Integer
Dim ChngCell As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim SrcRange As Range
Dim NewRow As Integer

'byla zmena a je vybran jiny radek od editovaneho?
If ChngCell = True And Not ActiveCell.Row = ChngRow Then

Set SrcRange = Range("A" & ChngRow & ":K" & ChngRow)

With Sheets("History")
NewRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & NewRow & ":K" & NewRow).Value = SrcRange.Value
.Range("L" & NewRow).Value = Now
.Range("M" & NewRow).Value = Environ("username")
End With
End If

ChngCell = False

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

ChngRow = Target.Row
ChngCell = True
End Sub

Ad 2)
Na začátek makra dej Application.EnableEvents = False a na konec =True