MS Excel

Ahoj, mám na listu formulář v podobě A4 a vedle ní tlačítka, nastavení roků aj. A potřebuji jen uložit oblast formuláře (tabulky,např.A1:K30) do nového sešitu, který se bude odesílat dál a nechci aby bylo vidět ostatní. Prošel jsem forum a našel uložení jen celého listu, ale ne jen vybrané oblasti.
Předem díky za pomoc

Zaslat odpověď >

eLCHa(9.5.2013 6:51)#013239

Např.:
Sub subCopy()
Dim rForm As Range
Set rForm = Range("A1:K30")

Dim wNew As Workbook
Set wNew = Workbooks.Add
rForm.Copy wNew.Sheets(1).Cells(1)

Set wNew = Nothing
Set rForm = Nothing
End Sub

nebo pro tento případ vhodnější (nebude obsahovat vzorce, takže se příjemci nepřepočte)
Sub subCopy2()
Dim rForm As Range
Set rForm = Range("A1:K30")

Dim wNew As Workbook
Set wNew = Workbooks.Add
rForm.Copy
With wNew.Sheets(1).Cells(1)
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With 'wNew.Sheets(1).Cells(1)

Application.CutCopyMode = False

Set wNew = Nothing
Set rForm = Nothing
End Subcitovat

sedlin(9.5.2013 7:31)#013241

Moc díky, vyzkouším a dám info

citovat

sedlin(9.5.2013 13:02)#013244

Vyzkoušeno, první varianta jede, ale neumí to formáty sloupců aj. a u druhé var. mi to vždy vyhodí hlášku " Run-time error '1004'> Application-difined or object-defined error" a skončím na řádku .PasteSpecial xlPasteValues, viz soubor v příloze - button Ulož ver2 je jak chci, ale bez pomocných tlačítek nalevo.

Příloha:

13244_interni-sdeleni-wall.7z (32kB, staženo 24x)

citovat

eLCHa(9.5.2013 13:53)#013245

Mno jo no. To jsou ty (nejen) vaše sloučené buňky ;))
Zrovna v tomto případě navíc zcela zbytečné, stačí
Zarovnat na střed výběru. Pak by to jelo.

Pokud na nich trváte, nahraďte
.PasteSpecial xlPasteValues
za
.PasteSpecial xlPasteValuesAndNumberFormats
toto by mělo fungovat i se sloučenýma buňkama (vyzkoušejte)

Nicméně se vám stejně nezkpoíruje ten WordArt. Navíc ho tam máte zbytečně, můžete to mít normálně v buňce

Pokud i na tom trváte, tak potom už jedině takováto šílenost
Sub subCopy3()
Dim rForm As Range
Set rForm = Range("B4:L51")

Dim wNew As Workbook
Set wNew = Workbooks.Add
rForm.Copy

With wNew.Sheets(1)
.Cells(1).PasteSpecial xlPasteColumnWidths
.Paste .Cells(1)
.Cells(1).PasteSpecial xlPasteValuesAndNumberFormats
End With 'wNew.Sheets(1)

Set wNew = Nothing
Set rForm = Nothing
End Subcitovat

Téma: uložení zadané oblasti do nového sešitu

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje