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
730
Vastaukset 7
- 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
Olen nainen pahoillani, että tykkään sinusta niin paljon, että
Haluaisin panna sua. Tuntuu vaan siltä, että olet sen suhteen ihan haluton. Ei minulle riitä pelkkä ystävyyssuhde.811168Puukotus Kajaanissa
Kuka puukotti ja ketä? https://yle.fi/a/74-20247765 Vähemmän yllättäen päihteet mainittu27749- 12734
- 90695
Mieti oikeasti
Ollaan lähes tuntemattomia, mutta samalla on tämä erityinen vuosien tilanne takana, joka on ollut monella tapaa väärin.30687- 46658
kene ajoi "kolarin"?
"Punkaharjulla Luston ja Tuppuranmäen välillä sattui tiistaina aamupäivällä liikenneonnettomuus. Poliisin mukaan Savonl14655Pahin tapa satuttaa toista
On jättää toinen vaille mitään vastausta. Erityisen kipeää se tekee sillon jos toinen ghostaa.68639Minulla on joskus ikävä sinua ja ajattelen sinua joskus.. edelleen
Olin joskus niin rakastunut sinuun. Olin onnellinen, että kohdattiin ja kun vain tiesin sinun olevan olemassa. Täytit aj27607- 56600
- 60573
- 41571
Alkaa jotenkin nyt kuvio hahmottuu täällä
Sellainen vaikutelma tästä alkaa tulla, että täällä on joku pieni porukka, joka tuntee toisensa tai ainakin pelaa samaan83569Jos kaivattusi on
Varattu niin miksi et antaisi asian olla hänen suhteen. Miksi ylipäätään vielä jatkat?46540- 43534
Hyvä on sitten, jos et sitä s*ksiä halua kanssani.
Rakastetaan vaan toisiamme, voin käydä muualla tyydyttämässä fyysisenpuolen tarpeet. Puhumalla tämäkin olisi selvinnyt.129517Nainen, tässä olen kahden vaiheilla
Toinen pitäisi valita ja kummassakin on hyvät ja huonot puolensa. Toinen olisi sellainen pysyvä mutta työläs. Toinen taa52503Kylän tielle remonttia?
Mitäköhän kylän tielle ruvetaan tekemään ku laitettu tuommoset töpsät muutamien suojateitten kohille?13492Suloinen ja herkkä
Toiset huomioiva, räväkkä, yllättävä. Ei sellaisesta voi olla pitämättä.31465Miten vuosien jälkeenkin tunteet voivat olla niin voimakkaat?
Että pelkkä ajatus sinusta täyttää silmät kyynelistä.27457