< návrat zpět

MS Excel


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

Zaslal/a 25.3.2014 16:13

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ěď >

#018496
avatar
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
#018517
avatar
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
#018523
avatar
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

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje