Eli, tällä hetkellä minulla on makro joka tallentaa koko taulukon ja sen välilehdet (sheets) omaan tiedostoonsa. Tähän tapaan:
ActiveWorkbook.SaveAs Filename:="C:\" & Vuosi & "_" & Kuukausi & "_" & Päivä & "_" & Tiedostonimi & "_" & Tieto1 & .xls"
Mitä tuohon pitäisi lisätä että se tallentaisi vain Sheet3 ja Sheet4 tuohon uuteen tiedostoon, ja jättäsisi Sheet1 ja 2 pois?
Tiettyjen välilehtien tallentaminen
bulma
7
707
Vastaukset
- oheisella
vakiokoodeilla pääset alkuun. Muuta sitä tarvittavaksi.
Sub TallennaSheetit()
Dim Tämätyökirja, Uusityökirja As String
Dim Lkm, Kpl As Integer
Dim Vuosi, Kuukausi, Päivä, Tiedostonimi As String
Application.ScreenUpdating = False
Vuosi = Year(Now())
Kuukausi = Month(Now())
Päivä = Day(Now())
Tiedostonimi = "Tiedot"
Tämätyökirja = ActiveWorkbook.Name
Workbooks.Add
Uusityökirja = ActiveWorkbook.Name
Lkm = 1
For Each sh In ActiveWorkbook.Sheets
sh.Name = Lkm
Lkm = Lkm 1
Next
Kpl = Lkm
Lkm = ActiveWorkbook.Sheets.Count
For Each sh In Workbooks(Tämätyökirja).Sheets
If sh.Name = "Sheet1" Or sh.Name = "Sheet2" Then GoTo Skip
sh.Copy after:=Workbooks(Uusityökirja).Sheets(Lkm)
Lkm = Lkm 1
Skip:
Next
Application.DisplayAlerts = False
Workbooks(Uusityökirja).Activate
For n = 1 To Kpl - 1
Sheets(1).Delete
Next
Sheets(1).Activate
ActiveWorkbook.SaveAs Filename:="C:\" & Vuosi & "_" & Kuukausi & "_" & Päivä & "_" & Tiedostonimi & "_" & "Tieto1" & ".xls"
ActiveWorkbook.Close
End Sub Sub Tallenna()
Sheets(Array("Sheet2", "Sheet4")).Copy
ActiveWorkbook.SaveAs Filename:="C:\" & Vuosi & "_" & Kuukausi & "_" & Päivä & "_" & Tiedostonimi & "_" & Tieto1 & .xls"
ActiveWindow.Close
End Sub
Keep Exceling
@Kunde- bulma
Sheets(Array("Sheet8", "Sheet9")).Copy
tuosta rivistä ei tykännyt. bulma kirjoitti:
Sheets(Array("Sheet8", "Sheet9")).Copy
tuosta rivistä ei tykännyt.Onkos työkirjassasi varmasti taulukot nimeltään Sheet8 ja Sheet9? Muuta virhemahdollisuutta en keksi, ellei sitten sinulla ole joku ikivanha versio käytössäsi ja se ei tue tuota Array ominaisuutta.
- bulma
kunde kirjoitti:
Onkos työkirjassasi varmasti taulukot nimeltään Sheet8 ja Sheet9? Muuta virhemahdollisuutta en keksi, ellei sitten sinulla ole joku ikivanha versio käytössäsi ja se ei tue tuota Array ominaisuutta.
Tosiaan eihän siellä ton nimisiä taulukoita ollut *läpsii itseään*
Osaisiko Expert excelisti vielä sanoa saisiko tuon tehtyä niin, että Sheet8 jossa on kaksi sivua tekstiä tallentuisi wordin dokumentiksi sivuiksi 1 ja 2. Sitten sheet9 n.5 sivua tallentuisi siitä sivuille 3-8?
Todella paljon kiitoksia avuista. bulma kirjoitti:
Tosiaan eihän siellä ton nimisiä taulukoita ollut *läpsii itseään*
Osaisiko Expert excelisti vielä sanoa saisiko tuon tehtyä niin, että Sheet8 jossa on kaksi sivua tekstiä tallentuisi wordin dokumentiksi sivuiksi 1 ja 2. Sitten sheet9 n.5 sivua tallentuisi siitä sivuille 3-8?
Todella paljon kiitoksia avuista.en tiedä miten excelin ruudukon voisi poistaa näkymästä muuten kuin kikkailemalla. Toisaalta taas kopioimalla excelistä solu kerrallaan on liian hidasta...
Sub ExcelistäWordiin()
Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim ws As Worksheet
On Error Resume Next
Set oWord = GetObject(, "Word.Application")
If Err Then
Set oWord = New Word.Application
End If
On Error GoTo virhe
oWord.DisplayAlerts = wdAlertsNone
oWord.Visible = True
oWord.Activate
Set oDoc = oWord.Documents.Add
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "Sheet8" Or ws.Name = "Sheet9" Then
ws.UsedRange.Copy
oDoc.Paragraphs(oDoc.Paragraphs.Count).Range.InsertParagraphAfter
oDoc.Paragraphs(oDoc.Paragraphs.Count).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=True
Application.CutCopyMode = False
oDoc.Paragraphs(oDoc.Paragraphs.Count).Range.InsertParagraphAfter
If Not ws.Name = Worksheets(Worksheets.Count).Name Then
With oDoc.Paragraphs(oDoc.Paragraphs.Count).Range
.InsertParagraphBefore
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdPageBreak
End With
End If
End If
Next ws
oDoc.Saved = True
oWord.DisplayAlerts = wdAlertsAll
Set oWord = Nothing
Set oDoc = Nothing
Exit Sub
virhe:
oWord.DisplayAlerts = wdAlertsAll
oWord.Quit
End Subkunde kirjoitti:
en tiedä miten excelin ruudukon voisi poistaa näkymästä muuten kuin kikkailemalla. Toisaalta taas kopioimalla excelistä solu kerrallaan on liian hidasta...
Sub ExcelistäWordiin()
Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim ws As Worksheet
On Error Resume Next
Set oWord = GetObject(, "Word.Application")
If Err Then
Set oWord = New Word.Application
End If
On Error GoTo virhe
oWord.DisplayAlerts = wdAlertsNone
oWord.Visible = True
oWord.Activate
Set oDoc = oWord.Documents.Add
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "Sheet8" Or ws.Name = "Sheet9" Then
ws.UsedRange.Copy
oDoc.Paragraphs(oDoc.Paragraphs.Count).Range.InsertParagraphAfter
oDoc.Paragraphs(oDoc.Paragraphs.Count).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=True
Application.CutCopyMode = False
oDoc.Paragraphs(oDoc.Paragraphs.Count).Range.InsertParagraphAfter
If Not ws.Name = Worksheets(Worksheets.Count).Name Then
With oDoc.Paragraphs(oDoc.Paragraphs.Count).Range
.InsertParagraphBefore
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdPageBreak
End With
End If
End If
Next ws
oDoc.Saved = True
oWord.DisplayAlerts = wdAlertsAll
Set oWord = Nothing
Set oDoc = Nothing
Exit Sub
virhe:
oWord.DisplayAlerts = wdAlertsAll
oWord.Quit
End Subnyt ei näy ruudukkoa...
Sub ExcelistäWordiin()
Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim ws As Worksheet
On Error Resume Next
Set oWord = GetObject(, "Word.Application")
If Err Then
Set oWord = New Word.Application
End If
On Error GoTo virhe
oWord.DisplayAlerts = wdAlertsNone
oWord.Visible = True
oWord.Activate
Set oDoc = oWord.Documents.Add
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "Sheet8" Or ws.Name = "Sheet9" Then
ws.UsedRange.Copy
oDoc.Paragraphs(oDoc.Paragraphs.Count).Range.InsertParagraphAfter
oDoc.Paragraphs(oDoc.Paragraphs.Count).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=True
Application.CutCopyMode = False
oDoc.Paragraphs(oDoc.Paragraphs.Count).Range.InsertParagraphAfter
If Not ws.Name = Worksheets(Worksheets.Count).Name Then
With oDoc.Paragraphs(oDoc.Paragraphs.Count).Range
.InsertParagraphBefore
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdPageBreak
End With
End If
End If
Next ws
For Each aTable In oWord.ActiveDocument.Tables
aTable.ConvertToText wdSeparateByTabs, True
Next aTable
oDoc.Saved = True
oWord.DisplayAlerts = wdAlertsAll
Set oWord = Nothing
Set oDoc = Nothing
Exit Sub
virhe:
oWord.DisplayAlerts = wdAlertsAll
oWord.Quit
End Sub
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
Suomalainen tutkimus paljasti oudon asian vasemmistolaisista - he häpeävät itseään
Kyllä, asia on faktaa. Suomalainen tutkimus osoittaa, että vasemmistolaisina itseään pitävät kansalaiset häpeävät itseää1383809Sosialismia Tampereella: Virallinen ilmiantolinja avautuu kaupungissa
Nyt siis mennään mansessa ihan justiinsa samaan malliin kuin entisessä Neuvostoliitossa, jossa saattoi ilmiantaa naapuri3362944Tätä et nähnyt tv:ssä: Frederik paljastaa - Totuus "haisevasta jäynästä" pehtoorille Farmilla
Frederik veti ns. herneen nenään ja päätti kostaa pehtoorille. Mitäs mieltä olet Frederikin "aamutoimista"? Lue jutt81855Ellen Jokikunnas paljastaa kyynelehtien Ralph-pojasta: "Apua..."
Ellen Jokikunnaksen ja hänen puolisonsa Jari Raskin perheestä ja taloprojektista Italiassa kertova Unelmia Italiassa -sa51588Oho! Vappu Pimiä teki "röyhkeän" teon - Onko sopivaa paljastaa tämä MasterChef-sarjasta?
Vappu Pimiä on astunut MasterChef Suomi -keittiöön ja liittynyt ohjelman legendaariseen tuomaristoon Helena Puolakan ja41069- 71914
Kaste tulisi tehdä apostolisella tavalla Ap. t. 2:38 mukaan
Apostolit eivät kastaneet kolminaisuuden nimellä vaan Jeesuksen alkuperäisen käskyn mukaisesti: Ap. t. 2:38 Niin Pietar38854- 44764
- 64724
Kuhmossa rallit alkoi ennen aikojaan
Paettiin polliisia törkeästi? Se tuo rallikiima on näemmä saavuttanu paikalliset tommi mäkiset kiljupäissään auton rat22708