kunden Function EtsiJaSiirrä

en ollut varma halusitko siirtää vain A-sarakkeen vaiko sarakkeiden A-N tiedot, joten fiksasin molemmat...


Option Explicit
Function EtsiJaSiirrä(Hakuehto As Variant) As Range
'etsii Sheet1 sarakkeesta A ja siirtää Sheet2 sarakkeeseen O
'oletuksena, että siirrettävät tiedot sarakkeissa A-N
Dim solu As Range
Dim solulaajennus As Range
Dim EkaOsoite As String
Worksheets("Sheet1").Activate
With Range("A:A")
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ä = solu
EkaOsoite = solu.Address
Set solulaajennus = solu.Resize(1, 14)
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solulaajennus)
Set solu = .FindNext(solu)
Set solulaajennus = solu.Resize(1, 14)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function

Sub Testi()
Dim Löydetty As Range
Dim alue As Areas
Dim Alueetlkm As Integer
Dim i As Integer
Dim Ylärivi As Long
Dim Vasensarake As Long
Dim YläVasen As Range
Dim KopioitavatAlueet() As Range

On Error GoTo virhe
Range("Sheet2!O:AB") = ""
Set Löydetty = EtsiJaSiirrä(11)
Alueetlkm = Löydetty.Areas.Count
ReDim KopioitavatAlueet(1 To Alueetlkm)
For i = 1 To Alueetlkm
Löydetty.Areas(i).Copy Range("Sheet2!O65536").End(xlUp).Offset(1, 0)
Next
Exit Sub
virhe:
MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
End Sub

Function EtsiJaSiirrä2(Hakuehto As Variant) As Range
'etsii Sheet1 sarakkeesta A ja siirtää Sheet2 sarakkeeseen O
'oletuksena, että haettavat tiedot vain sarakkeessa A
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Sheet1").Activate
With Range("A:A")
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(11)
Range("Sheet2!O:O") = ""
Löydetty.Copy Range("Sheet2!O65536").End(xlUp).Offset(1, 0)
Exit Sub
virhe:
MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
End Sub

kunde kirjoitti:

en ollut varma halusitko siirtää vain A-sarakkeen vaiko sarakkeiden A-N tiedot, joten fiksasin molemmat...


Option Explicit
Function EtsiJaSiirrä(Hakuehto As Variant) As Range
'etsii Sheet1 sarakkeesta A ja siirtää Sheet2 sarakkeeseen O
'oletuksena, että siirrettävät tiedot sarakkeissa A-N
Dim solu As Range
Dim solulaajennus As Range
Dim EkaOsoite As String
Worksheets("Sheet1").Activate
With Range("A:A")
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ä = solu
EkaOsoite = solu.Address
Set solulaajennus = solu.Resize(1, 14)
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solulaajennus)
Set solu = .FindNext(solu)
Set solulaajennus = solu.Resize(1, 14)
Loop While Not solu Is Nothing And solu.Address EkaOsoite
End If
End With
End Function

Sub Testi()
Dim Löydetty As Range
Dim alue As Areas
Dim Alueetlkm As Integer
Dim i As Integer
Dim Ylärivi As Long
Dim Vasensarake As Long
Dim YläVasen As Range
Dim KopioitavatAlueet() As Range

On Error GoTo virhe
Range("Sheet2!O:AB") = ""
Set Löydetty = EtsiJaSiirrä(11)
Alueetlkm = Löydetty.Areas.Count
ReDim KopioitavatAlueet(1 To Alueetlkm)
For i = 1 To Alueetlkm
Löydetty.Areas(i).Copy Range("Sheet2!O65536").End(xlUp).Offset(1, 0)
Next
Exit Sub
virhe:
MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
End Sub

Function EtsiJaSiirrä2(Hakuehto As Variant) As Range
'etsii Sheet1 sarakkeesta A ja siirtää Sheet2 sarakkeeseen O
'oletuksena, että haettavat tiedot vain sarakkeessa A
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Sheet1").Activate
With Range("A:A")
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(11)
Range("Sheet2!O:O") = ""
Löydetty.Copy Range("Sheet2!O65536").End(xlUp).Offset(1, 0)
Exit Sub
virhe:
MsgBox "hakuehdoilla ei löytynyt tietoja!", vbInformation
End Sub

Lue lisää

Kiitos. Ei tainnut mennä kun viikko kun itse yritin pari tuntia päivässä ratkaista siirtoa siis noilla linkin jutuilla, eikä onnannut tai onnistui mutta aina A sarakkeeseen.
Nyt on hyvä kun pystyy tekemään vaikka mitä siirtoja, HYVÄ Functio ja koodit!!!

Saisko vielä yhden vinkin, miksi ja mitä tarkoittaa Option Explicit.
Kun se joskus laitetaan moduliin ja joskus ei, Miksi, mitä se tekee?

Makro-Marko kirjoitti:

Kiitos. Ei tainnut mennä kun viikko kun itse yritin pari tuntia päivässä ratkaista siirtoa siis noilla linkin jutuilla, eikä onnannut tai onnistui mutta aina A sarakkeeseen.
Nyt on hyvä kun pystyy tekemään vaikka mitä siirtoja, HYVÄ Functio ja koodit!!!

Saisko vielä yhden vinkin, miksi ja mitä tarkoittaa Option Explicit.
Kun se joskus laitetaan moduliin ja joskus ei, Miksi, mitä se tekee?

Lue lisää

Option Explicit tarkoittaa, että muuttujat on määriteltävä esim dim z as integer.

... kirjoitti:

Option Explicit tarkoittaa, että muuttujat on määriteltävä esim dim z as integer.

tänks

Makro-Marko kirjoitti:

tänks

että homma toimii...
Ko funktio on todella monipuolinen, mutta sehän perustuukin Range- objektiin, mikä on mitä monipuolisin objekti Excelin kirjastossa. Soveltamalla saa aikaiseksi uskomattomia juttuja parin rivin koodilla ...

Tattista vaan
Keep Excelling
@Kunde