< návrat zpět

MS Excel


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

Zaslal/a 6.5.2013 19:14

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ěď >

icon #013239
eLCHa
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 Sub
citovat
#013241
avatar
Moc díky, vyzkouším a dám info 1citovat
#013244
avatar
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: 7z13244_interni-sdeleni-wall.7z (32kB, staženo 21x)
citovat
icon #013245
eLCHa
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 Sub
citovat

Uživatelské menu

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

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

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

Aktivní diskuse