excel -šlo by to zjedodušit ?

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Zamčeno
spespe
nováček
Příspěvky: 12
Registrován: 28 úno 2013 10:43

excel -šlo by to zjedodušit ?

Příspěvek od spespe »

Zdravím
vytvořil jsem si makro , tak jak je je plně funkční,ale přijde mi že jsem to řešil až nějak moc složitě, že by to mohlo jít i jinak.
Pokud by někdo měl náladu a chuť se na to podívat a případně mi poradil co by se dalo udělat líp,byl bych velmi vděčen.

Ještě se pokusím vysvětlit co to má vlastně dělat
Z listu2 (aktuálně skrytý ), je potřeba přesunout řádky do listu pojmenovaného po prvním sloupci a zároveň do listu přehled. pokud list nebude existovat tak je potřeba vytvořit nový se správným jménem. Ostatní listy jako seznam nejsou potřeba,ale jinak jsem to nedokázal vymyslet :oops:
Přílohy
pokus.xlsm
(21.62 KiB) Staženo 36 x
cmuch
Level 4.5
Level 4.5
Příspěvky: 1547
Registrován: 02 bře 2011 19:12
Bydliště: Drsná Vysočina :D

Re: excel -šlo by to zjedodušit ?

Příspěvek od cmuch »

Jen tak rychle poradím
Koukni tady

Je to hodně podobné tomu tvému požadavku.

//Chvilka se našla, snad je to ono

Kód: Vybrat vše

Sub KopirujDlePodminky4()

Dim Radek, RowPasteToSh As Long
Dim ZdrojList, PasteToSh, PasteToSh2 As Variant

PasteToSh2 = "prehled"
ZdrojList = "List2"

Application.ScreenUpdating = False
Sheets(ZdrojList).Visible = True
Sheets(ZdrojList).Select

For Radek = 1 To Cells(Rows.Count, 1).End(xlUp).Row
 
        ' na jaky list kopirovat
        PasteToSh = Cells(Radek, 1).Value
       
        If Not PasteToSh = Empty Then ' Existuje-li list pro kopirovani, kopiruj
            On Error GoTo err
NwSh:
            RowPasteToSh = Sheets(PasteToSh).Cells(Rows.Count, 1).End(xlUp).Row + 1
            On Error GoTo 0
       
            Worksheets(PasteToSh).Rows(RowPasteToSh).Value = Rows(Radek).Value
           
            RowPasteToSh = Sheets(PasteToSh2).Cells(Rows.Count, 1).End(xlUp).Row + 1
            Worksheets(PasteToSh2).Rows(RowPasteToSh).Value = Rows(Radek).Value
        End If
Next Radek
 
Sheets(ZdrojList).Select
Cells.ClearContents

Sheets(PasteToSh2).Select
Sheets(ZdrojList).Visible = False

Application.ScreenUpdating = True

Exit Sub

err:
  Sheets.Add After:=Sheets(Sheets.Count)
  ActiveSheet.Name = PasteToSh
  Sheets(ZdrojList).Select
  GoTo NwSh

End Sub
spespe
nováček
Příspěvky: 12
Registrován: 28 úno 2013 10:43

Re: excel -šlo by to zjedodušit ?

Příspěvek od spespe »

Tak to byla rychlost :-)
Díky za jinej pohled, plácám si ty makra jak se kde dočtu :-)
Zamčeno
  • Podobná témata
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Přechod z Excel 21 na Excel 24
    od Snekment » » v Kancelářské balíky
    2 Odpovědi
    14407 Zobrazení
    Poslední příspěvek od Snekment
  • Pohoda a excel
    od brownwld » » v Kancelářské balíky
    1 Odpovědi
    7330 Zobrazení
    Poslední příspěvek od atari
  • Tisk sloupců vedle sebe na A4 - Excel
    od atari » » v Kancelářské balíky
    5 Odpovědi
    5912 Zobrazení
    Poslední příspěvek od atari
  • Excel 2016 - vzorec kombinace podmínek
    od MK_Vs » » v Kancelářské balíky
    5 Odpovědi
    6134 Zobrazení
    Poslední příspěvek od lubo.

Zpět na „Kancelářské balíky“