Siirsin tämän ylemmäksi

Kyselijä

Otin tämän vanhan makron käyttöön ja olen sen saanut toimimaan sen verran hyvin että ainoa vika taitaa olla jos on sama erä eri vuosille niin se korjaa aikaisemman vuoden erän?

Sub Kopioi()
Dim vika As Integer
Dim Haettava As Range
Dim Haettava2 As Range
Dim Hakualue As Range
Dim Löydetty As Range
Dim EkaSolu As String
Sheets("Syöttö").Activate
Set Haettava = Range("M9")
Set Haettava2 = Range("O6")
Sheets("Data").Activate
vika = Range("B65536").End(xlUp).Row

Set Hakualue = Range("B1:B" & vika)
Range("B1").Select
Set Löydetty = Hakualue.Find(What:=Haettava, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False)
If Not Löydetty Is Nothing Then
EkaSolu = Löydetty.Address
If Löydetty.Offset(0, 3) = Haettava2 Then
msg = "Erä on jo olemassa_1! " & "Haluatko tallentaa vanhan päälle!"
response = MsgBox(msg, vbYesNo)
If response = vbYes Then Range(EkaSolu).Offset(0, 1) = Sheets("Syöttö").Range("I9") Else Exit Sub
Range(EkaSolu).Offset(0, 2) = Sheets("Syöttö").Range("D9")
Range(EkaSolu).Offset(0, 4) = Sheets("Syöttö").Range("A13")
Exit Sub
Else
Do
Set Löydetty = Hakualue.FindNext(Löydetty)
If Löydetty.Offset(0, 3) = Haettava2 Then
msg = "Erä on jo olemassa_2! " & "Haluatko tallentaa vanhan päälle!"
response = MsgBox(msg, vbYesNo)
If response = vbYes Then Range(EkaSolu).Offset(0, 1) = Sheets("Syöttö").Range("I9") Else Exit Sub
Range(EkaSolu).Offset(0, 2) = Sheets("Syöttö").Range("D9")
Range(EkaSolu).Offset(0, 4) = Sheets("Syöttö").Range("A13")
Exit Sub
End If
Loop While Not Löydetty Is Nothing And Löydetty.Address EkaSolu
Range("B" & vika 1) = Haettava
Range("B" & vika 1).Offset(0, 3) = Haettava2
Call tallennatiedot(vika)
End If
Else
Range("B" & vika 1) = Haettava
Range("B" & vika 1).Offset(0, 3) = Haettava2
Call tallennatiedot(vika)

End If
End Sub

2

287

Äänestä

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • kyselijä

      Tämä viestiketju on tuolla alempana "11032006 kysytty" nimellä mutta ajattelin sen menevän kohta piiloon enkä saa siihen sitten vastausta, joten siirsin sen tähän ylemmäksi.

      Makron piti hakea tietoa Syöttö lehdeltä ja tarkistaa että Data lehdellä ei ole vastaavia tietoja Erän ja Vuoden mukaan jos on niin kysyy tallennetaanko päälle , muuten tallentaa tiedot Data lehdelle.

      • kyselijä

        (varmaankin jotain virheitä / päälekkäisyyksiä makrossa on?) muuten hyvä mutta jos tiedot on jo olemassa ja vastaa ei korvataanko kysymykseen niin se tulee makrosta pois ja jättää data sivun esille , hyvä mutta se jää data sivun yläreunaan pitäisi saada jäämää siihen kohtaan missä tiedot on?

        Sub erantallennus()
        Dim vika As Integer
        Dim Haettava As Range
        Dim Haettava2 As Range
        Dim Hakualue As Range
        Dim Löydetty As Range
        Dim EkaSolu As String
        Dim TokaSolu As String
        Sheets("Syöttö").Activate
        Set Haettava = Range("M9")
        Set Haettava2 = Range("O6")
        Sheets("Data").Activate
        vika = Range("B65536").End(xlUp).Row

        Set Hakualue = Range("B1:B" & vika)
        Range("B1").Select
        Set Löydetty = Hakualue.Find(What:=Haettava, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False)
        If Not Löydetty Is Nothing Then
        EkaSolu = Löydetty.Address
        If Löydetty.Offset(0, 3) = Haettava2 Then
        msg = "Erä on jo olemassa! " & "Haluatko tallentaa vanhan päälle!"
        response = MsgBox(msg, vbYesNo)
        If response = vbYes Then Range(EkaSolu).Offset(0, 1) = Sheets("Syöttö").Range("I9") Else Exit Sub
        Range(EkaSolu).Offset(0, 1) = Sheets("Syöttö").Range("D9")
        Range(EkaSolu).Offset(0, 2) = Sheets("Syöttö").Range("I9")
        Sheets("Syöttö").Activate
        MsgBox "Muista tallentaa myös koko tiedosto!"
        Exit Sub
        Else
        Do
        Set Löydetty = Hakualue.FindNext(Löydetty)
        If Löydetty.Offset(0, 3) = Haettava2 Then
        TokaSolu = Löydetty.Address
        msg = "Erä on jo olemassa! " & "Haluatko tallentaa vanhan päälle!"
        response = MsgBox(msg, vbYesNo)
        If response = vbYes Then Range(TokaSolu).Offset(0, 1) = Sheets("Syöttö").Range("I9") Else Exit Sub
        Range(TokaSolu).Offset(0, 1) = Sheets("Syöttö").Range("D9")
        Range(TokaSolu).Offset(0, 2) = Sheets("Syöttö").Range("I9")
        Sheets("Syöttö").Activate
        MsgBox "Muista tallentaa myös koko tiedosto!"
        Exit Sub
        End If
        Loop While Not Löydetty Is Nothing And Löydetty.Address EkaSolu
        Range("B" & vika 1) = Haettava
        Range("B" & vika 1).Offset(0, 3) = Haettava2
        Call tallennatiedot(vika)
        MsgBox "Muista tallentaa myös koko tiedosto!"

        End If
        Else
        Range("B" & vika 1) = Haettava
        Range("B" & vika 1).Offset(0, 3) = Haettava2
        Call tallennatiedot(vika)
        MsgBox "Muista tallentaa myös koko tiedosto!"

        End If
        End Sub

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

    Takaisin ylös

    Luetuimmat keskustelut

    1. Elikkä Riikka Purra ei kannusta Suomea edes euroviisuissa

      Sellaista on persujen "isänmaallisuus", oma kansa viimeiseksi ja ulkomaalaiset ensimmäisiksi. https://www.iltalehti.fi/
      Maailman menoa
      179
      2688

    2. Mitä kirjainta haluaisit

      rakastella juuri nyt?
      Ikävä
      164
      2509

    3. Victoria-tytär, 16, vertaa Martina Aitolehteä ja Esko Eerikäistä: "Iskä on enemmän..."

      Martina Aitolehti ja Esko Eerikäinen ovat ex-pari ja heillä on yksi yhteinen tytär, Victoria. Eerikäinen oli Huomenta Su
      Kotimaiset julkkisjuorut
      118
      2187

    4. Riikka: 3 euron bensa, Ruotsi: bensavero jopa alle EU-minimin

      Eipä vaan suomalainen autoilija saa kaikkien rakastamalta Riikalta sympatiaa. Ruotsissa on eri meininki, siellä diskutee
      Maailman menoa
      61
      2063

    5. Riikka runnoo: datakeskuksille tulee UUSI yritystuki

      "Suomen valtio erikseen tukee esimerkiksi kryptovaluuttaan tai aikuisviihteeseen tai muuhun keskittyviä datakeskuksia."
      Maailman menoa
      3
      1729

    6. "UKRAINA HYÖKKÄÄ LATVIAN ÖLJYVARASTOON JA JUNAAN"!!!

      "MATKUSTAJAJUNA SAI UKRAINALAISLENNOKEISTA VAKAVIA VAURIOITA"!!!
      Maailman menoa
      59
      1444

    7. Hilma Hallo-ahon kuvat julki - kiistää SSK ryhmän nimen merkityksen

      Eduskunnan puhemies Jussi Halla-ahon tyttären ympärille on noussut skandaali. Lehdistö sai selville Hilma Hallo-ahon kuu
      Perussuomalaiset
      204
      1420

    8. Miten kestätte tyhmiä?

      Miten usein turhaudutte tai suututte ihmisiin, joilla on matala älykkyys? Minulla tätä tapahtuu useita kertoja viikossa
      Sinkut
      225
      1163

    9. Sofia Belorf rehellisenä suhteen alusta Jeff-miljonäärirakkaaseen: "Hän ei..."

      Sofia Belórfin elämä on tapetilla Sofia Bling Bling Dubai -realityssä. Näyttävien puitteiden rinnalla Belórf avaa elämää
      Kotimaiset julkkisjuorut
      93
      1128

    10. Äänestän seuraavissa eduskuntavaaleissa persuja.

      Persut on ainoa puolue, joka aidosti vastustaa islamisaatiota Suomessa.
      Maailman menoa
      370
      1073
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt