MS Excel

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:
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

Zaslat odpověď >

cmuch(25.3.2014 17:34)#018496

ad1)
Asi bych to udělal takto

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
Vlož do listu z kterého se bude kopírovat.

edit:
Ad2)
tak na začátek makra dej application.enableevents=false a na konec to same ale s truecitovat

bloom(26.3.2014 12:45)#018517

Díky moc, všechno funguje. :) Ještě bych možná poprosil o radu s jednou věcí - rád bych, aby se kopírovací makro nespustilo hned, když uživatel klikne do buňky, ta se přepne do editace, uživatel v ní ale nic nezmění a nezměněnou ji opustí.
Mohl bych požádat o radu ještě s totuo záležitostí (co kam do kódu doplnit apod.)? Mnohokrát děkuji. bloomcitovat

cmuch(26.3.2014 20:35)#018523

tak tak
Dim ChngRow As Integer
Dim ChngCell As Boolean
Dim ChngCellValueOld As Variant
Dim ChngCellValueNew As Variant

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 And Not ChngCellValueOld = ChngCellValueNew Then

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

With Sheets("List2")
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
ChngCellValueOld = ActiveCell.Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

ChngRow = Target.Row
ChngCell = True
ChngCellValueNew = Target.Value
End Sub
citovat

Téma: Excel - úprava kopírujícího makra

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje