excel -šlo by to zjedodušit ? Vyřešeno

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

Moderátor: Mods_senior

spespe
nováček
Příspěvky: 12
Registrován: únor 13
Pohlaví: Nespecifikováno
Stav:
Offline

excel -šlo by to zjedodušit ?

Příspěvekod spespe » 05 dub 2013 19:16

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 28 x

Reklama
cmuch
Level 4.5
Level 4.5
Příspěvky: 1547
Registrován: březen 11
Bydliště: Drsná Vysočina :D
Pohlaví: Muž
Stav:
Offline

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

Příspěvekod cmuch » 05 dub 2013 19:51

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: únor 13
Pohlaví: Nespecifikováno
Stav:
Offline

Re: excel -šlo by to zjedodušit ?  Vyřešeno

Příspěvekod spespe » 07 dub 2013 14:40

Tak to byla rychlost :-)
Díky za jinej pohled, plácám si ty makra jak se kde dočtu :-)


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • EXCEL -jak otevřít 2 excel sobory abych je viděla současne a samostatně
    od Ketty02 » 30 srp 2024 21:19 » v Vše ostatní (sw)
    2
    4819
    od Riviera kid Zobrazit poslední příspěvek
    02 zář 2024 16:21
  • Přechod z Excel 21 na Excel 24
    od Snekment » 29 led 2025 13:46 » v Kancelářské balíky
    2
    12235
    od Snekment Zobrazit poslední příspěvek
    29 led 2025 15:05
  • Pohoda a excel Příloha(y)
    od brownwld » 06 kvě 2025 17:28 » v Kancelářské balíky
    1
    4786
    od atari Zobrazit poslední příspěvek
    07 kvě 2025 09:41
  • Excel - výpočet nočních hodin Příloha(y)
    od Uziv00 » 17 říj 2024 11:22 » v Kancelářské balíky
    3
    3359
    od lubo. Zobrazit poslední příspěvek
    24 říj 2024 00:00
  • Tisk sloupců vedle sebe na A4 - Excel
    od atari » 24 dub 2025 10:51 » v Kancelářské balíky
    5
    3947
    od atari Zobrazit poslední příspěvek
    26 dub 2025 09:11

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

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 3 hosti