automatické kopírování celých řádků mezi listy
Napsal: 16 říj 2008 15:27
od xhave
Ahoj,
chtěla jsem poprosit o pomoc
chtěla bych v excelu provést následující akci -
v listu1 si vytvářím databázi s infomacema o subjektech ve sloupci A si písmenem označím typ subjektu a chtěla bych aby podle písmene se mi jednotlivé řádky rozkopírovaly na následující listy.
něco v duchu "if A1= L, zkopírovat celý řádek na list2" , "if A1=M, zkopírovat celý řádek na list3" atd.
nevím jestli na to existuje nějaká funkce, nebo musím přes makro.
Pokud přes makro - neporadili byste mi někdo nějaký zdroj pro základy programování maker.
díky předem
Re: automatické kopírování celých řádků mezi listy
Napsal: 16 říj 2008 17:44
od navstevnik
resenim je procedura ve VBA
v editoru VBA (spustit Alt+F11) vlozit do modulu nasledujici:
Kód: Vybrat vše
Option Explicit
Option Compare Binary
Sub KopirovatNaListy()
' zdrojova data jsou na aktivnim listu, na cilovych listech v prvnim radku hlavicky
' nazvy cilovych listu jsou definovany v teto subrutine
Dim ZdrojOblast As Range, ZdrojRadek As Range, PoslSloupec As Range, c As Range
Dim CilList As String, CilRadek As Range, PoslRadek As Range
Set ZdrojOblast = ActiveSheet.UsedRange
Set ZdrojOblast = ZdrojOblast.Resize(ZdrojOblast.Rows.Count, 1)
For Each c In ZdrojOblast.Cells
' urceni poctu bunek v radku na zdrojovem listu
Set PoslSloupec = ActiveSheet.Range(c.Row & ":" & c.Row).Cells(Range(c.Row & ":" & c.Row).Cells.Count)
' presun na posledni neprazdny sloupec
If IsEmpty(PoslSloupec) Then Set PoslSloupec = PoslSloupec.End(xlToLeft)
' definovat zdrojovy radek, zdrojova data zacinaji ve sloupci B:B,
' ve sloupci A:A je identifikace ciloveho listu
Set ZdrojRadek = c.Resize(1, PoslSloupec.Column - 1).Offset(0, 1)
' urceni nazvu ciloveho listu
Select Case c.Value
Case "L"
CilList = "list3"
Case "M"
CilList = "list4"
Case "N"
CilList = "list5"
' dalsi listy
End Select
' urceni posledniho radku na cilovem listu, ulozena data zacinaji ve sloupci A:A
Set PoslRadek = Worksheets(CilList).Range("A:A").Cells(Range("A:A").Cells.Count)
' presun na posledni neprazny radek listu
If IsEmpty(PoslRadek) Then Set PoslRadek = PoslRadek.End(xlUp)
Set CilRadek = PoslRadek.Resize(1, PoslSloupec.Column - 1).Offset(1, 0) 'definovat cilovy radek
CilRadek.Value = ZdrojRadek.Value
Next c
End Subk programovani: treba zde
http://www.officir.ic.cz/excelentne.html nebo
http://www.xlpert.com/toc.htm a hledat vhodne zdroje na netu