• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Spojení listu do 1

Zaslal/a milotaho 13.5.2011 22:07

Dobrý den,

V práci máme 6 sešitů které mají cca 150 listu. V číselní řadě viď příloha. (Jsou to kontrolní plány pro kontrolu jakosti, nemůžu poskytnout originál, na každém listu je jedna stránka A4.)
Chtěl bych se zeptat jestli by bylo možné napsat makro které by spojilo pod sebe obsah listu zakončeních _1 / _2 atd. do hlavního listu z názvem 1000/1001 .Kde _1/2/3 je neznáma je v rozmezí 1 až 20. A po zkopírováni listu by se list smazal a zůstaly by jenom listy 1000/1001 atd.
Předem moc děkuji.

Příloha: 4983_konrolni_plan.zip (3kB, staženo 14x)

Zaslat odpověď >

---

misocko(15.5.2011 13:23)#004989

posli jeden (ak su vsetky formatovo rovneke) origo list - data nejak poprepisuj musim vidiet formatovanie buniek a ktore su plne a ktore prazdne, vsetky maju rovnaky pocet riadkov?citovat

milotaho(19.5.2011 20:24)#005021

děkuji za rychlou reakci, přišel jsem na to, že to končí většinou 52 řádkem, ale je tam několik listů kde je 54, tak jsem se domluvil, že to ujednotíme, o víkendu sem hodím ten jeden listcitovat

milotaho(30.5.2011 21:27)#005114

Tak konečně jsem se k tomu dostal. Vytvářel to někdo hoooooodně dávno, takže je to word v tabulkách.

Příloha: 5114_konrolni_plan_1.zip (3kB, staženo 14x)

citovat

misocko(30.5.2011 21:56)#005115

pozrem na to , nebude problem spojit to ale zachovat strankovanie pre tlac asi bude pre mna trochu oriesok - no nic uvidimecitovat

Anonym(1.6.2011 21:35)#005146

stránkováni není problém protože se to bude všechno procházet a redukovat + se nastaví záhlaví a zápatí a moc díkcitovat

misocko(2.6.2011 19:10)#005157

skus tento kod, ZALOHUJ SI ORGINALY, "undo alebo zpet" nefubguje, je to na 54 riadkov, este skusam elegantnejsiu verziu , ale to az potom co toto bude OK

ak by to neslo budem potrebovat zopar orginal pomenovanych listov


Sub spoj_listy()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Sheets(1).Select
Sheets.Add
Sheets(1).Select

x = 1
For Each llist In ActiveWorkbook.Sheets
Cells(x, 1).Value = llist.Name
x = x + 1
Next llist

Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("B1").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],SEARCH(""_"",RC[-1])-1)"
Selection.AutoFill Destination:=Range(Cells(1, 2), Cells(ActiveSheet.UsedRange.Rows.Count, 2)), Type:=xlFillDefault

Range(Cells(1, 2), Cells(ActiveSheet.UsedRange.Rows.Count, 2)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Columns("A:A").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft

For riadok = 2 To ActiveSheet.UsedRange.Rows.Count
If Cells(riadok, 1).Value = Cells(riadok - 1, 1).Value Then
Rows(riadok).Delete
riadok = riadok - 1
End If
If Cells(riadok, 1).Value = "" Then GoTo kk
Next riadok
kk:

pocetlistov = ActiveSheet.UsedRange.Rows.Count
For riadok = 1 To pocetlistov
Sheets(1).Select
menolistu = Cells(riadok, 1).Value
Sheets(2).Select
Sheets.Add
Sheets(2).Select
Sheets(2).Name = menolistu
Next riadok

Sheets(1).Select
ActiveWindow.SelectedSheets.Delete

For x = 1 To pocetlistov
For Each llist In ActiveWorkbook.Sheets
If InStr(1, llist.Name, "_") = 0 Then GoTo ky
If Sheets(x).Name = Left(llist.Name, InStr(1, llist.Name, "_") - 1) Then
llist.Activate
Range(Cells(1, 1), Cells(54, 11)).Select
Selection.Copy
Sheets(x).Activate
Cells(Range("h36556").End(xlUp).Row + 2, 1).Select
ActiveSheet.Paste
End If
ky:
Next llist
Next x

End Sub
citovat

misocko(15.6.2011 19:18)#005263

co takto napisat sem ci to funguje alebo nefunguje, nechcem ziadne prachy (odpovedal som dobrovolne), nechcem ani "dik" (podakoval si v zadani) ale ak nieco spravim ocakavam odozvu aspon vo forme "OK" alebo "NOK"

dakujem citovat

milotaho(15.6.2011 22:40)#005265

Ahoj předem se omlouvám ale Němci nám vzaly přístup na web, takže sem si to přepsal a ještě nestihl otestovat v práci. ještě jednou se omlouvám a určitě napíšu jestli to funguje a nebo ne.A hlavně dík za pomoccitovat

misocko(16.6.2011 18:28)#005272

citovat

milotaho(18.6.2011 22:30)#005288

Tak po přepsáni se mi to nepovedlo rozchodit hlási to chybu neplatný autofill.Děkuji za snahu ale už si to rozebraly kontroloři a každý to má upravyt protože tam jsou ještě staré data.Takže to musí promazat.Děkujicitovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse