Arvojen siirto

Caale

Seuraavanlaiseen ongelmaan kyselisin apua.
Sheet1 B2:M2 sisältää funktioilla saatuja lukuja.
Pitäisi saada siirrettyä nämä luvut arvoina Sheet2:ssa olevaan taulukkoon seuraavalle vapaana
olevalle riville. Rivejä taulukossa on 25.
Minkähänlaisella makrolla moinen voisi onnistua?

12

475

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • Nimimerkki

      Pienellä testi taululla sain tällaisen toimimaa, huomaa siinä on muutamia komentoja joita voisit yhdistää, mutta laitoin noin että koodi olisi selvemmin luettavissa mitä se tekee.



      Public Sub lisaaOsa()

      Dim sarakeJossaEiOleTyhjaa As String
      Dim ekaRivi As Double

      Dim vikaRivi As Double
      Dim uusiRivi As Double

      Dim solutJotkaKopioidaan As Range
      Dim solutJohonKopioidaan As Range

      sarakeJossaEiOleTyhjaa = "B"
      ekaRivi = 19

      vikaRivi = Sheet2.Range(sarakeJossaEiOleTyhjaa & ekaRivi).End(xlDown).Row
      uusiRivi = vikaRivi 1


      Set solutJotkaKopioidaan = Sheet1.Range("B2:M2")
      Set solutJohonKopioidaan = Sheet2.Range("B" & uusiRivi & ":M" & uusiRivi)

      solutJohonKopioidaan.Value = solutJotkaKopioidaan.Value


      End Sub




      huomaa myös tuo muuttuja "sarakeJossaEiOleTyhjaa" siinä sarakkeessa ei saa olla tyhjiä soluja välissä jos käytät tätä lausetta:

      vikaRivi = Sheet2.Range(sarakeJossaEiOleTyhjaa & ekaRivi).End(xlDown).Row

      toinen vaihtoehto olisi

      vikaRivi = Sheet2.Range(sarakeJossaEiOleTyhjaa & "65536").End(xlup).Row

      • Nimimerkki

        Public Sub lisaaOsa()

        Dim uusiRivi As Integer
        Dim solutJotkaKopioidaan As Range
        Dim solutJohonKopioidaan As Range

        uusiRivi = Sheet2.Range("B19").End(xlDown).Row 1
        Sheet2.Range("B" & uusiRivi & ":M" & uusiRivi).Value = Sheet1.Range("B2:M2").Value

        End Sub


      • Nimimerkki
        Nimimerkki kirjoitti:

        Public Sub lisaaOsa()

        Dim uusiRivi As Integer
        Dim solutJotkaKopioidaan As Range
        Dim solutJohonKopioidaan As Range

        uusiRivi = Sheet2.Range("B19").End(xlDown).Row 1
        Sheet2.Range("B" & uusiRivi & ":M" & uusiRivi).Value = Sheet1.Range("B2:M2").Value

        End Sub

        Public Sub lisaaOsa()

        Dim uusiRivi As Integer
        Dim solutJotkaKopioidaan As Range
        Dim solutJohonKopioidaan As Range

        uusiRivi = Sheet2.Range("B65536").End(xlUp).Row 1
        Sheet2.Range("B" & uusiRivi & ":M" & uusiRivi).Value = Sheet1.Range("B2:M2").Value

        End Sub


    • Sub Kopioi()
      Dim KopioAlue As Range
      On Error Resume Next
      Set KopioAlue = Range("Taul1!B2:M2")'muuta aluetta tarvittaessa
      KopioAlue.Copy Destination:=Range("Taul2!B65536").End(xlUp).Offset(1, 0) 'kopioi B sarakkeesta alkaen muuta tarvittaessa
      End Sub

      • Nimimerkki

        hieno ja tiivis koodi, mutta ei toimi oikein


      • Nimimerkki kirjoitti:

        hieno ja tiivis koodi, mutta ei toimi oikein

        Mikä virheilmoitus tulee jos hipsaat On Error Resume Next rivin?
        Ainakin mulla kopioi Taul1 alueen B2:M2 Taul2 aina seuraavalle vapaalle riville B sarakkeessa


      • Nimimerkki
        kunde kirjoitti:

        Mikä virheilmoitus tulee jos hipsaat On Error Resume Next rivin?
        Ainakin mulla kopioi Taul1 alueen B2:M2 Taul2 aina seuraavalle vapaalle riville B sarakkeessa

        Ei virheilmoitusta, mutta kopioi noihin vain nollia.
        Kun tarkistin noi ei ne nollia ollutkaan vaan kaavoja jotka palauttaa nollia. Eli koodi on oikein vaikka testi ei läpi mennyt.


      • Nimimerkki kirjoitti:

        Ei virheilmoitusta, mutta kopioi noihin vain nollia.
        Kun tarkistin noi ei ne nollia ollutkaan vaan kaavoja jotka palauttaa nollia. Eli koodi on oikein vaikka testi ei läpi mennyt.

        kysyjä halusikin vain arvot...

        Sub Kopioi()
        On Error Resume Next
        Range("Taul1!B2:M2").Copy 'muuta aluetta tarvittaessa
        Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues) 'kopioi B sarakkeesta alkaen muuta tarvittaessa
        End Sub


      • Caale
        kunde kirjoitti:

        kysyjä halusikin vain arvot...

        Sub Kopioi()
        On Error Resume Next
        Range("Taul1!B2:M2").Copy 'muuta aluetta tarvittaessa
        Range("Taul2!B65536").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues) 'kopioi B sarakkeesta alkaen muuta tarvittaessa
        End Sub

        Kundelle ja Nimimerkille. Homma toimii juuri niinkuin halusin Kunden jälkimmäisellä makrolla. Osaisinpa vaan itsekin tehdä.


      • Caale
        Caale kirjoitti:

        Kundelle ja Nimimerkille. Homma toimii juuri niinkuin halusin Kunden jälkimmäisellä makrolla. Osaisinpa vaan itsekin tehdä.

        Makro toimii muuten hienosti, mutta huomasin jälkeenpäin, että alue, jonne tiedot kopioidaan Taul2:ssa jää aktiiviseksi (maalatuksi).
        Saakohan sitä mitenkään muutetuksi ja kursorin paikaksi vaikka solu A1 Taul2:ssa. Yrityksistä
        huolimatta en saanut asiaa korjatuksi.


      • Nimimerkki
        Caale kirjoitti:

        Makro toimii muuten hienosti, mutta huomasin jälkeenpäin, että alue, jonne tiedot kopioidaan Taul2:ssa jää aktiiviseksi (maalatuksi).
        Saakohan sitä mitenkään muutetuksi ja kursorin paikaksi vaikka solu A1 Taul2:ssa. Yrityksistä
        huolimatta en saanut asiaa korjatuksi.

        Tuossa minun koodissa ei aktivoitu kursoria ollenkaan, eikä muutenkaan vaikuteta kursorin liikkeisiin.
        Siinä minun koodissa vain sijoitettiin arvot ( Value ) toisesta paikasta toiseen paikkaan, ja tiivistetty koodihan oli:


        Dim uusiRivi As Integer
        Dim solutJotkaKopioidaan As Range
        Dim solutJohonKopioidaan As Range

        uusiRivi = Sheet2.Range("B65536").End(xlUp).Row 1
        Set solutJotkaKopioidaan = Sheet1.Range("B2:M2")
        Set solutJohonKopioidaan = Sheet2.Range("B" & uusiRivi & ":M" & uusiRivi)

        solutJohonKopioidaan.Value = solutJotkaKopioidaan.Value


        Kokeile muokata tuosta sinulle sopivaksi


      • Caale
        Nimimerkki kirjoitti:

        Tuossa minun koodissa ei aktivoitu kursoria ollenkaan, eikä muutenkaan vaikuteta kursorin liikkeisiin.
        Siinä minun koodissa vain sijoitettiin arvot ( Value ) toisesta paikasta toiseen paikkaan, ja tiivistetty koodihan oli:


        Dim uusiRivi As Integer
        Dim solutJotkaKopioidaan As Range
        Dim solutJohonKopioidaan As Range

        uusiRivi = Sheet2.Range("B65536").End(xlUp).Row 1
        Set solutJotkaKopioidaan = Sheet1.Range("B2:M2")
        Set solutJohonKopioidaan = Sheet2.Range("B" & uusiRivi & ":M" & uusiRivi)

        solutJohonKopioidaan.Value = solutJotkaKopioidaan.Value


        Kokeile muokata tuosta sinulle sopivaksi

        Nyt toimii juuri niinkuin halusinkin. Kiitos!


    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Luetuimmat keskustelut

    1. Kuvat! Dannyyn liitetty Helmi Loukasmäki, 22, on puhjennut naisena kukkaan - Some sekoaa: "Sä..."

      Ooo, kaunis aikuinen nainen Helmistä on kasvanut siinä yli 80-vuotiaan Dannyn rinnalla! Katso uudet kuvat: https://ww
      Suomalaiset julkkikset
      57
      4230
    2. Henkirikos Alakylässä

      Nainen löydetty elottomana, mies otettu kiinni. Mitä on tapahtunut?
      Seinäjoki
      47
      2891
    3. Suodatinpussin kastelemalla saa parempaa kahvia

      Kokeilin niksiä ja kyllä tämä kahvi on parempaa nyt. Ei lainkaan maistu paperiselta. Huljuttelee hanan alla suppiloa pap
      Maailman menoa
      132
      2175
    4. Tidätkö nainen

      että suoraan sanottuna v.tut.aa että pääsit näin lähelle minua. Ei olisi oikeasti aikaa tähän mutta silti aina välillä o
      Ikävä
      105
      1896
    5. Mikä on kaivattusi etunimi?

      Otsikossa siis on kysymys eriteltynä. Vain oikeat vastaukset hyväksytään.
      Ikävä
      64
      1383
    6. Onkohan sinulla kaikki hyvin?

      Nyt vähän sellainen outo tunne tuli. Sinun asiasi niin ei minulle toki tarvitse kertoa. Kunhan mietin...
      Ikävä
      38
      1177
    7. Viimeinen reissu tälle kesälle

      Pian se syksy on. Hyvää huomenta ja aurinkoista päivää. ☕🌞🍁🌻🐺❤️
      Ikävä
      173
      1066
    8. Huikeeta, mahtavaa, ihan mielettömän upeeta

      Me ostettiin talo Espanjasta. Tosin saadaan käyttää sitä vain muutama viikko vuodessa kun on monta muutakin ostajaa! M
      Kotimaiset julkkisjuorut
      187
      1049
    9. En kestä katsoa

      Sitä miten sinusta on muut kiinnostuneita. Olen kateellinen. Siksi pitäisi lähteä pois
      Ikävä
      87
      1048
    10. Oho! Arja Koriseva paljastaa TTK:n ekasta suorasta lähetyksestä: "On vähän ärsyttävä yhtälö!"

      Upea Arja Koriseva! Tsemppiä haasteelliseen tilanteeseen! Lue lisää: https://www.suomi24.fi/viihde/oho-arja-koriseva-
      Suomalaiset julkkikset
      16
      1012
    Aihe