< návrat zpět

MS Excel


Téma: Makrem tvorba X listů rss

Zaslal/a 4.10.2010 11:54

potřeboval bych nějak možná i makrem vytvořit následující...
V příloze je jednoduchý list excelu a na něm data.
Dle sloupce PRA_Mistr,seřizov. vyhodit číslo jako nový list,
čili číslo 0,31,32,33,34,35.Mělo by vzniknout 6 nových listů v tomto souboru s názvy uvedených výše a do těch listů načíst všechny řádky z listu1 které odpovídají jen jednotlivým číslům dle čísla nově vytvořených listů.

Příloha: zip2614_stroje2.zip (19kB, staženo 18x)
Zaslat odpověď >

icon #002619
Poki
slo by to mozna takto:Sub kopirovani()
Application.ScreenUpdating = False
For i = 2 To List1.Cells(65000, 12).End(xlUp).Row
If List1.Cells(i, 12) <> List1.Cells(i - 1, 12) Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = List1.Cells(i, 12)
End If
If Worksheets.Count > 1 And IsEmpty(Worksheets(Worksheets.Count).Cells(1, 1)) = True Then
j = List1.Range("L:L").Find(List1.Cells(i, 12)).Row
Do Until List1.Cells(j, 12) <> List1.Cells(i, 12)
j = j + 1
Loop
List1.Select
List1.Range("a1:o1").Copy
Worksheets(Worksheets.Count).Select
Worksheets(Worksheets.Count).Range("a1").Select: ActiveSheet.Paste

List1.Select
List1.Range(Cells(List1.Range("L:L").Find(List1.Cells(i, 12)).Row, 1), Cells(j - 1, 15)).Copy
Worksheets(Worksheets.Count).Select
Worksheets(Worksheets.Count).Cells(Worksheets(Worksheets.Count).Cells(65000, 1).End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlValue
ActiveSheet.PageSetup.PrintArea = ActiveSheet.UsedRange.Address
ActiveSheet.UsedRange.Borders.LineStyle = xlContinuous
ActiveSheet.UsedRange.BorderAround Weight:=xlMedium
End If
Next i
Application.ScreenUpdating = True
End Sub
citovat
#002633
avatar
Děkuji....Funguje to jak má, pokud je to seřezeno dle toho mistra. Šlo by ještě na těch nově vzniklých listech v rámci toho makra ty nově vzniklé tabulky ještě ohraničit do tabulky a označit rovnou oblast tisku?
Dokážu to udělat záznamem makra, ale problém je ten ,že pokaždé tam může být jiný počet řádků a tabulka by buď byla z části prázdná a nebo by v opačném případě zase nebyly data v ohraničených buňkách.citovat
icon #002635
Poki
upravil jsem puvodni kod (viz vys)citovat
#002636
avatar
Ano je to skoro jak jsem potřeboval , jen ještě nevím , zda byste tam nedodělal i slabším ohraničením jednotlivých buněk , které jsou jako celek ohraničeny silnou čarou a ještě mi tam chybí hlavičky na každém listu z toho prvního List1, pak už to bude OK ...Makrům nerozumím tak prosím ještě o tuto úpravu a asi to začnu vážně biflovat...díky.citovat
icon #002637
Poki
opet jsem upravil kod vyse...citovat
#002638
avatar
Děkuji to je přesně ono.....citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje