Tiettyjen välilehtien tallentaminen

bulma

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?

7

706

Äänestä

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • 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

    • kunde

      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.

      • kunde
        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.

      • kunde
        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 Sub

      • kunde
        kunde 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 Sub

        nyt 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ä.

    Takaisin ylös

    Luetuimmat keskustelut

    1. Eutanasia?

      Kertokaas omia mielipiteitä eutanasiaan liittyen. Onko mielestäsi oikein vai väärin ja miksi?
      Arvot ja etiikka
      7
      12406

    2. Eutanasia - miksi eläimelle sallitaan armokuolema, mutta ihmiselle ei?

      Olen pitkään ihmetellyt yhtä asiaa Suomessa. Kun koira kärsii parantumattomasta sairaudesta ja kovista kivuista, eläinlä
      Arvot ja etiikka
      4
      11173

    3. Riikka Purran kaudella nousi bensan hinta yli 2 euron

      Muistatteko kuinka edellisen vasemmistohallituksen aikana, ns. Marinin aikakaudella, bensiiniä sai 1,3 euron litrahinnal
      Maailman menoa
      175
      5095

    4. Veli Sofia teki urosmehiläisen työn

      Paljastaessaan kuinka TPS:ssä ei joukkuehenki toimi sooloilijoiden vuoksi, jonka takia koko seura ei pärjää kilpailussa
      Maailman menoa
      28
      3709

    5. Mitäs nyt sijoittajat?

      Pörssit laskevat maailmalla Iranin sodan takia ja muutenkin ovat olleet Trumpin vallan alla epävarmat. Ainoa, mikä on no
      Maailman menoa
      196
      3544

    6. Hjallis Harkimon, 72, Jasmine-rakas, 37, paljastaa suhteen alusta: "Vähän..."

      Liikemies, kansanedustaja Hjallis Harkimo ja tuottaja-juontaja Jasmine Pajari ovat pariskunta. He asuvat yhdessä Sipooss
      Suomalaiset julkkikset
      47
      3094

    7. Unisex-vessat

      Ahdistaa. Miksi kaikki pitää tasapäistää tasa-arvon nimissä? Tasa-arvo on sitä, että kunnioitetaan sukupuolien erilaisu
      Tunteet
      108
      2829

    8. Jäit kiinni siitä

      että katselet minua. Käänsin pääni, minäkin etsin sinua, ja meidän katseemme kohtasivat. Eikä se haittaa - molemmat ky
      Ikävä
      13
      2358

    9. Sosiaalidemokratia romahtanut kautta maailman

      nuoret eivät enää kannata järjetöntä aatetta, joten demarien täytyy hakea kannattajia mamuista. Ruotsin sos.demit jo kie
      Maailman menoa
      39
      2138

    10. Jutta Larm, 52, haluaa kumota tämän piintyneen ikämyytin

      Oletko samaa mieltä? Jutta Larm on 52-vuotias ja tehnyt pitkän uran yrittäjänä. Hän haluaa kumota tämän piintyneen ikämy
      50 plus
      19
      1955
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt