Tietojen tuominen toisesta työkirjasta makrolla

Muuttele nimet ja polut oikeaksi

Sub Makro1()
Dim polku As String
Dim tiedostonnimi As String
Dim lähde As Workbook

polku = "C:\"
tiedosto = "malli_02"
Worksheets("Taul1").Range("A:P") = ""

Set lähde = Workbooks.Open(polku & tiedosto)

ThisWorkbook.Worksheets("Taul1").Range("A1:P1000").Value = lähde.Sheets("Taul1").Range("A1:P1000").Value
lähde.Close False
Range("A1").Select
ActiveWorkbook.Worksheets("Taul1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Taul1").Sort.SortFields.Add Key:=Range("A1:A20"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Taul1").Sort
.SetRange Range("A1:P1000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

Sub Makro2()
Worksheets("Taul1").Range("A:P") = ""
Worksheets("Taul1").Range("A1:P1000").Value = Worksheets("Taul2").Range("A1:P1000").Value
Range("A1").Select
ActiveWorkbook.Worksheets("Taul1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Taul1").Sort.SortFields.Add Key:=Range("A1:A20"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Taul1").Sort
.SetRange Range("A1:P1000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

Sub Makro3()
Dim vika As Long
Dim löydetty As Range
Dim löydetty2 As Range
Dim polku As String
Dim tiedostonnimi As String
Dim lähde As Workbook
Dim solu As Range
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Huuhaa").Delete
On Error GoTo virhe
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Huuhaa"
polku = "C:\"
tiedosto = "malli_04"

Set lähde = Workbooks.Open(polku & tiedosto)

ThisWorkbook.Worksheets("Huuhaa").Range("F1:I1000").Value = lähde.Sheets("Taul1").Range("A1:D1000").Value
lähde.Close False
ThisWorkbook.Worksheets("Taul1").Range("A1:D1000").Copy Worksheets("Huuhaa").Range("A1:D1000")
With Worksheets("Huuhaa").Range("E1")
.FormulaR1C1 = "=RC[-4]&RC[-3]&RC[-1]"
.AutoFill Destination:=Range("E1:E20")
End With
With Worksheets("Huuhaa").Range("J1")
.FormulaR1C1 = "=RC[-4]&RC[-3]&RC[-1]"
.AutoFill Destination:=Range("J1:J20")
End With
vika = Worksheets("Huuhaa").Range("J65536").End(xlUp).Row
For Each solu In Worksheets("Huuhaa").Range("J1:J" & vika)
Set löydetty = EtsiJaSiirrä(solu, Columns("E:E"))
If Not löydetty Is Nothing Then
If löydetty2 Is Nothing Then
Set löydetty2 = löydetty
Else
Set löydetty2 = Union(löydetty2, löydetty)
End If
End If
Next
Worksheets("Taul1").Range(löydetty2.Address).EntireRow.Delete
virhe:
ThisWorkbook.Worksheets("Huuhaa").Delete
Application.DisplayAlerts = True
End Sub

Function EtsiJaSiirrä(Hakuehto As Variant, HakuAlue As Range) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Huuhaa").Activate
With HakuAlue
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
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address <> EkaOsoite
End If
End With
End Function


Keep EXCELing
@Kunde