automatické kopírování celých řádků mezi listy

[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

[Reklama]

[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 Sub

k programovani: treba zde http://www.officir.ic.cz/excelentne.html nebo http://www.xlpert.com/toc.htm a hledat vhodne zdroje na netu