nahral bych i ukazku, ale píše mi to "Uložení se nezdařilo. Pravděpodobně jste nezadal(a) text nebo znaky z kontrolního obrázku."
http://uloz.to/xtNHwRnZ/pokus-1-xlsx
:((citovat
http://uloz.to/xtNHwRnZ/pokus-1-xlsx
:((citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: kopírování po změně
MS Excel
Téma: kopírování po změně 
Zaslal/a Sirka 4.5.2015 14:07
ahoj, prosím o radu
potřeboval bych o radu jak udělat, aby když dojde ke změně ve sloupci A (A5-A26) a B (B5-B26) na listu list1 > tzn zmačknu enter a bunka se naplní, aby se překopírovala do jendotlivých listu, na poslední volný řádek sloupce A.
předem díky :)
Toto musí byť makrom, takže choď do okna VBA (Alt+F11), kde 2x klikneš na List1, a tam vlož tento kód:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Bunka As Range
Set Zmena = Intersect(Range("A5:B26"), Target)
If Not Zmena Is Nothing Then
For Each Bunka In Zmena
With Worksheets(IIf(Bunka.Column = 1, "A", "B"))
.Cells(.Cells(Rows.Count, "A").End(xlUp).Row + IIf(IsEmpty(.Cells(1, 1)), 0, 1), 1) = Bunka.Value
End With
Next Bunka
End If
End Sub
Funkcia funguje aj keď príde k zmene viacerých buniek naraz v oboch stĺpcoch (napr kopírovaním).citovat
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Bunka As Range
Set Zmena = Intersect(Range("A5:B26"), Target)
If Not Zmena Is Nothing Then
For Each Bunka In Zmena
With Worksheets(IIf(Bunka.Column = 1, "A", "B"))
.Cells(.Cells(Rows.Count, "A").End(xlUp).Row + IIf(IsEmpty(.Cells(1, 1)), 0, 1), 1) = Bunka.Value
End With
Next Bunka
End If
End Sub
Funkcia funguje aj keď príde k zmene viacerých buniek naraz v oboch stĺpcoch (napr kopírovaním).citovat
výbroně děkuji,
a jen jestli bych mohl poprotist upravit, aby se mi to dávalo na list A do sloupce A a třeba H. tzn list B vubec nepoužít. Pokud by to tedy nebyl nejaký závažný problém.
Děkujicitovat
a jen jestli bych mohl poprotist upravit, aby se mi to dávalo na list A do sloupce A a třeba H. tzn list B vubec nepoužít. Pokud by to tedy nebyl nejaký závažný problém.
Děkujicitovat
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Bunka As Range
Set Zmena = Intersect(Range("A5:B26"), Target)
If Not Zmena Is Nothing Then
For Each Bunka In Zmena
With Worksheets("A")
.Cells(.Cells(Rows.Count, IIf(Bunka.Column = 1, "A", "H")).End(xlUp).Row + IIf(IsEmpty(.Cells(1, IIf(Bunka.Column = 1, "A", "H"))), 0, 1), 1) = Bunka.Value
End With
Next Bunka
End If
End Sub
Vyskúšaj, toto dávam v polospánku zbrucha na tablete.citovat
Dim Zmena As Range, Bunka As Range
Set Zmena = Intersect(Range("A5:B26"), Target)
If Not Zmena Is Nothing Then
For Each Bunka In Zmena
With Worksheets("A")
.Cells(.Cells(Rows.Count, IIf(Bunka.Column = 1, "A", "H")).End(xlUp).Row + IIf(IsEmpty(.Cells(1, IIf(Bunka.Column = 1, "A", "H"))), 0, 1), 1) = Bunka.Value
End With
Next Bunka
End If
End Sub
Vyskúšaj, toto dávam v polospánku zbrucha na tablete.citovat
nefunguje :(
kopíruje to hodnoty z A a B ale do listu A a vždy na A sloupec, a přepisuje poslední hodnotu. tzn zapisuje jen do A1.
ale i tak díky :) samo za opravenou verzi se zlobit nebudu :)))citovat
kopíruje to hodnoty z A a B ale do listu A a vždy na A sloupec, a přepisuje poslední hodnotu. tzn zapisuje jen do A1.
ale i tak díky :) samo za opravenou verzi se zlobit nebudu :)))citovat
a nebo mě napadlo pokdu by to fungovalo, tak to napsat na jen sloupec A a druhý pro jen sloupec B. že bych dal jako dvě makra pod sebe. Pokud by to takhle mohlo fungovat.citovat
Prepáč, zabudol som na tú poslednú "1". Teraz to už funguje. Iba som zmenil tie IIF na Prepinac, aby to bolo zreteľnejšie, a doplnil tento Prepinac aj namiesto tej poslednej "1".
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Bunka As Range, Prepinac As String
Set Zmena = Intersect(Range("A5:B26"), Target)
If Not Zmena Is Nothing Then
For Each Bunka In Zmena
Prepinac = IIf(Bunka.Column = 1, "A", "H")
With Worksheets("A")
.Cells(.Cells(Rows.Count, Prepinac).End(xlUp).Row + IIf(IsEmpty(.Cells(1, Prepinac)), 0, 1), Prepinac) = Bunka.Value
End With
Next Bunka
End If
End Sub
citovat
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Bunka As Range, Prepinac As String
Set Zmena = Intersect(Range("A5:B26"), Target)
If Not Zmena Is Nothing Then
For Each Bunka In Zmena
Prepinac = IIf(Bunka.Column = 1, "A", "H")
With Worksheets("A")
.Cells(.Cells(Rows.Count, Prepinac).End(xlUp).Row + IIf(IsEmpty(.Cells(1, Prepinac)), 0, 1), Prepinac) = Bunka.Value
End With
Next Bunka
End If
End Sub
citovat
tak ještě jen prosím o malinkou změnu.
přehazel jsem sloupečky a neumím to dát dohromady ...
a tedy k tomu co bych potřeboval a troch jsem to i rozšíril :( ...
pokud vyplním hodnotu v bunce B5:B26 nebo F5:F26 a zmačknu enter, tak se mi hodnota sumy vedle ve sloupečku překopíruje na list A jak tomu bylo doposud.
dále by jsem potřeboval zamknout bunku v přislušnem řadku A a B proti nechtěnému přepisu a to až do doby než zmačknu tlačítko odemknout
možná lepší komentář je v přiložením archivu v bunce B5
předem děkuji za odpověď a pomoc.
snad moc neotravuji
přehazel jsem sloupečky a neumím to dát dohromady ...
a tedy k tomu co bych potřeboval a troch jsem to i rozšíril :( ...
pokud vyplním hodnotu v bunce B5:B26 nebo F5:F26 a zmačknu enter, tak se mi hodnota sumy vedle ve sloupečku překopíruje na list A jak tomu bylo doposud.
dále by jsem potřeboval zamknout bunku v přislušnem řadku A a B proti nechtěnému přepisu a to až do doby než zmačknu tlačítko odemknout
možná lepší komentář je v přiložením archivu v bunce B5
předem děkuji za odpověď a pomoc.
snad moc neotravuji
Příloha: 
24856_kopirovani.rar (11kB, staženo 19x)
citovat24856_kopirovani.rar (11kB, staženo 19x)tak zamknutí jsem provedl
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="heslo"
Target.Locked = True
Target.FormulaHidden = False
ActiveSheet.Protect Password:="heslo", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
odemknutí
Sheets("zaznam").Unprotect ("heslo")
Range("A5:B26, E5:F26, I5, I7").Select
Selection.Locked = False
Selection.FormulaHidden = False
nevím jestli je to správně, nicméně bych potřeboval vyloučit z tohodle pravidla bunku I5 a I7citovat
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="heslo"
Target.Locked = True
Target.FormulaHidden = False
ActiveSheet.Protect Password:="heslo", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
odemknutí
Sheets("zaznam").Unprotect ("heslo")
Range("A5:B26, E5:F26, I5, I7").Select
Selection.Locked = False
Selection.FormulaHidden = False
nevím jestli je to správně, nicméně bych potřeboval vyloučit z tohodle pravidla bunku I5 a I7citovat
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
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.
RSS nejnovější články