< návrat zpět
MS Excel
Téma: Makrem tvorba X listů 
Zaslal/a bach1 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:
2614_stroje2.zip (19kB, staženo 18x)
Poki(4.10.2010 14:26)#002619
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 Subcitovat
bach1(4.10.2010 20:32)#002633 
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
Poki(5.10.2010 9:05)#002635
upravil jsem puvodni kod (viz vys)
citovat
bach1(5.10.2010 9:49)#002636 
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
Poki(5.10.2010 10:57)#002637
opet jsem upravil kod vyse...
citovat
bach1(5.10.2010 11:39)#002638 
Děkuji to je přesně ono.....
citovat