Tietojen tuominen toisesta työkirjasta makrolla

rampeka

1. Suomenkielinen excel. Työkirjat malli_01 ja toinen työkirja malli_02 sarakkeita a:sta p:en ja rivejä 1000.
Pitäisi tuoda malli_01 :een malli_02:sta sarakke ja rivitiedot ja seljälkeen järjestää rivit sarakkeen A mukaan aakkosjärjestykseen.

2. Sama työkirja ja kaksi taulukkoa. Pitäisi tuoda malli_01 :een malli_01b:sta sarakke ja rivitiedot malli_01:een ja seljälkeen järjestää rivit sarakkeen A mukaan aakkosjärjestykseen.

3. Työkirjat malli_01 ja toinen työkirja malli_04 sarakkeita a:sta p:n ja rivejä 1000. Pitäisi poistaa koko rivitieto malli_01:sta jos sarakkeista A,C ja D jos löytyy sama tieto kuin malli_04 sarakkeista A,C ja D
3 erillistä makroa

2

226

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • 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

      • Tänks... testaillaan....


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

    Luetuimmat keskustelut

    1. Laitetaas nyt kirjaimet tänne

      kuka kaipaa ja ketä ?
      Ikävä
      142
      10771
    2. Pieni häivähdys sinusta

      Olet niin totinen
      Ikävä
      52
      5160
    3. Taas ryssittiin oikein kunnolla

      r….ä hyökkäsi Viroon sikaili taas ajattelematta yhtään mitään https://www.is.fi/ulkomaat/art-2000011347289.html
      NATO
      45
      2363
    4. Lähetä terveisesi kaipaamallesi henkilölle

      Vauva-palstalta tuttua kaipaamista uudessa ympäristössä. Kaipuu jatkukoon 💘
      Ikävä
      114
      2229
    5. Missä olet ollut tänään kaivattuni?

      Ikävä sai yliotteen ❤️ En nähnyt sua tänään söpö mies
      Ikävä
      29
      2063
    6. Vanha Suola janottaa Iivarilla

      Vanha suola janottaa Siikalatvan kunnanjohtaja Pekka Iivaria. Mies kiertää Kemijärven kyläjuhlia ja kulttuuritapahtumia
      Kemijärvi
      13
      1661
    7. Valtimon Haapajärvellä paatti mäni nurin

      Ikävä onnettomuus Haapajärvellä. Vene hörpppi vettä matkalla saaren. Veneessä ol 5 henkilöä, kolme uiskenteli rantaan,
      Nurmes
      41
      1492
    8. Tiedän kuka sinä noista olet

      Lucky for you, olen rakastunut sinuun joten en reagoi negatiivisesti. Voit kertoa kavereillesi että kyl vaan, rakkautta
      Ikävä
      29
      1174
    9. Känniläiset veneessä?

      Siinä taas päästiin näyttämään miten tyhmiä känniläiset on. Heh heh "Kaikki osalliset ovat täysi-ikäisiä ja alkoholin v
      Nurmes
      34
      1143
    10. Rakastuminenhan on psykoosi

      Ei ihme että olen täysin vailla järkeä sen asian suhteen. Eipä olis aikoinaan arvannut, että tossa se tyyppi menee, jonk
      Ikävä
      55
      1034
    Aihe