EtsiJaSiirrä

H_J_H

Kellään vinkkejä kuinka sais tämän toimimaan oikein?! Haetaan vaikkapa sarakkeesta G jotain sanaa ja kunnes sana löytyy niin kopioidaan saman rivin sarakkeet A,B ja C sheetille2. Olen pyöritellyt tämäm foorumin vinkkejä ja alkaa jo kohta hermo menee... :/

Mitähän muutosta tähän pitäis tehdä???

Function EtsiJaSiirrä2(Hakuehto As Variant) As Range

Dim solu As Range
Dim EkaOsoite As String
Worksheets("Sheet1").Activate
With Range("G:G")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä2 = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä2 = Union(EtsiJaSiirrä2, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function

Sub Testi2()
Dim Löydetty As Range
On Error GoTo virhe
Set Löydetty = EtsiJaSiirrä2("Nok")
Union(Löydetty, Löydetty).Copy Range("Sheet2!A65536").End(xlUp).Offset(1, 1)
Exit Sub
virhe:
MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
End Sub

2

411

    Vastaukset 2

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • Function EtsiJaSiirrä2(Hakuehto As Variant) As Range

      Dim solu As Range
      Dim EkaOsoite As String
      Worksheets("Sheet1").Activate
      With Range("G:G")
      Set solu = .Find( _
      What:=Hakuehto, _
      LookIn:=xlValues, _
      LookAt:=xlWhole, _
      SearchOrder:=xlByRows, _
      SearchDirection:=xlNext, _
      MatchCase:=False, _
      SearchFormat:=False)
      If Not solu Is Nothing Then
      Set EtsiJaSiirrä2 = solu
      EkaOsoite = solu.Address
      Do
      Set EtsiJaSiirrä2 = Union(EtsiJaSiirrä2, solu)
      Set solu = .FindNext(solu)
      Loop While Not solu Is Nothing And solu.Address EkaOsoite
      End If
      End With
      End Function

      Sub Testi2()
      Dim Löydetty As Range
      Dim solu As Range
      On Error GoTo virhe
      Set Löydetty = EtsiJaSiirrä2("Nok")
      For Each solu In Löydetty
      Union(solu.Offset(0, -6), solu.Offset(0, -5), solu.Offset(0, -4)).Copy Range("Sheet2!A65536").End(xlUp).Offset(1, 0)
      Next
      Exit Sub
      virhe:
      MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
      End Sub

      • H_J_H

        Kiitoksia....Nyt pelaa!!!


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

    Luetuimmat keskustelut

    1. Onko sulla rakas mitään sanottavaa?

      Lähetä tässä kaivatullesi haluamasi terveiset 💌
      Ikävä
      308
      2431
    2. Liikenneonnettomuus kuhmo

      Taisi Audi mennä lunastukseen ja pemari kilometritehtaalle
      Kuhmo
      26
      1507
    3. Nanna hakkasi Martinan aivot tuusan nuuskaksi!!!

      Ihme jos Martina pystyy muodostaa järkeviä lauseita tämän nyrkkisateen jälkeen. Ottelupalkkio tuli, tajunta meni.
      Kotimaiset julkkisjuorut
      277
      1442
    4. Vaikea löytää samantyylistä miestä

      Nyt on pakko avautua. Onko ketään muuta jonka on yksinkertaisesti todella vaikeaa löytää samanhenkistä kumppania kuin i
      Sinkut
      148
      937
    5. Oot sä aika nuorekas...

      Vaikka oot niin vanha!
      Ikävä
      45
      919
    6. Rasismi ahdistaa.

      Tapasin baarissa oikein lupsakan oloisen miehen, mutta arvomaailma on hyvin erilainen omani kanssa. Hän käyttää n-sanaa
      Sinkut
      257
      813
    7. Martina ja Muhis

      Aamulenkillä yhdessä valmistautumassa suuren päivään,toivottavasti heräsivät toistensa viekusta.Ihana pariskunta❤
      Kotimaiset julkkisjuorut
      238
      747
    8. Näin sut.

      olitpas vanhentuneen näköinen. 😆 mieheltä naiselle
      Ikävä
      56
      590
    9. Olenkohan tunteideni kanssa yksin?

      Salaa toivon, että sinä nainen luotat minuun niin paljon, että uskaltaisit lähentyä kanssani, vaikka tämä on vähän kiell
      Ikävä
      46
      521
    10. Oot pelkkä naurun aihe

      🤣🤣🤣🤣🤣 m-n
      Ikävä
      38
      498
    Aihe