Kopiointi yhdestä tiedostosta

toisen taulukon välilehtiin?

Hei, Kuinka saisin tehtyä makron, joka kopioisi tiedostosta AA.xls välilehdeltä taul2 sarakkeet D:stä F:ään ja sen jälkeen liittää tiedot tiedostoon BB.xls:n kaikkiin välilehtiin samoille sarakkeille?

7

666

Äänestä

    Vastaukset 7

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • kunde

      vaihda polut oikeaksi ja jos haluat , että aktiivisesta työkirjasta tekee siirron suljettuina oleviin (AA.xls ja BB.xls) niin poista hipsut. Nyt kopioi suljetusta AA.xls aktiiviseen työkirjaan... Sub Kopioi() Dim wb As Workbook Dim ws As Worksheet On Error Resume Next Application.ScreenUpdating = False Application.DisplayAlerts = False Set wb = Workbooks.Open("C:\AA.xls", True, True) On Error GoTo 0 If Not wb Is Nothing Then On Error Resume Next wb.Worksheets("Taul2").Range("D:F").Copy On Error GoTo 0 wb.Close False Set wb = Nothing 'Set wb = Workbooks.Open("C:\BB.xls", True, False) 'On Error GoTo 0 ' If Not wb Is Nothing Then On Error Resume Next For Each ws In Sheets If ws.Visible Then ws.Select (False) Next Range("D:F") = "" Range("D1").Select ActiveSheet.Paste Sheets(1).Select Range("D1").Select ' wb.Close True ' Set wb = Nothing ' ' End If End If Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Keep Excelling @Kunde

      • tyytyväinen...................

        Hei, Kiitoksia vba:sta. Homma toimii. Kuitenkin AA tiedostosta kopioidut solut eivät tule BB tiedostoon samassa muodossa. Tiedot tulivat pelkkänä numerona tai tekstinä, vaikka (AA tiedostossa) D sarakkeessa on kaavoja, jotka pitäisi saada uuteen taulukkoon. Saisinko vielä vähän apua tähän? Jos haluaisin kopioida esim. AA tiedostossa taul1 ensimmäiset 2 riviä, niin kuinka VBA koodi poikkeaa sarakkeiden kopioinnista? Kiitoksia etukäteen.

      • kunde
        tyytyväinen................... kirjoitti:

        Hei, Kiitoksia vba:sta. Homma toimii. Kuitenkin AA tiedostosta kopioidut solut eivät tule BB tiedostoon samassa muodossa. Tiedot tulivat pelkkänä numerona tai tekstinä, vaikka (AA tiedostossa) D sarakkeessa on kaavoja, jotka pitäisi saada uuteen taulukkoon. Saisinko vielä vähän apua tähän? Jos haluaisin kopioida esim. AA tiedostossa taul1 ensimmäiset 2 riviä, niin kuinka VBA koodi poikkeaa sarakkeiden kopioinnista? Kiitoksia etukäteen.

        Sub Kopioi() 'kopioi suljetusta työkirjasta aktiiviseen työkirjaan Dim wb As Workbook Dim wb2 As Workbook Dim ws As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False Set wb = ActiveWorkbook Set wb2 = Workbooks.Open("C:\AA.xls", True, True) On Error GoTo 0 If Not wb2 Is Nothing Then On Error Resume Next For Each ws In wb.Worksheets If ws.Visible Then ws.Select Range("D:F") = "" wb2.Worksheets("Taul2").Range("D:F").Copy Range("D1") ' 2 ekaa riviä hipsaa ylläoleva rivi ja poista hipsu allaolevalta riviltä ' wb2.Worksheets("Taul2").Range("1:2").Copy Range("D1") End If Next wb2.Close False Set wb2 = Nothing End If Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Sub Kopioi2() 'kopioi suljetusta työkirjasta suljettuun työkirjaan Dim wb As Workbook Dim wb2 As Workbook Dim ws As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False On Error GoTo 0 Set wb2 = Workbooks.Open("C:\AA.xls", True, True) If Not wb2 Is Nothing Then Set wb = Workbooks.Open("C:\BB.xls", True, False) If Not wb Is Nothing Then On Error Resume Next For Each ws In wb.Worksheets If ws.Visible Then ws.Select Range("D:F") = "" wb2.Worksheets("Taul2").Range("D:F").Copy Range("D1") ' 2 ekaa riviä hipsaa ylläoleva rivi ja poista hipsu allaolevalta riviltä ' wb2.Worksheets("Taul2").Range("1:2").Copy Range("D1") End If Next End If End If wb2.Close False Set wb2 = Nothing wb.Close True Set wb = Nothing Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

      • hmm...
        kunde kirjoitti:

        Sub Kopioi() 'kopioi suljetusta työkirjasta aktiiviseen työkirjaan Dim wb As Workbook Dim wb2 As Workbook Dim ws As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False Set wb = ActiveWorkbook Set wb2 = Workbooks.Open("C:\AA.xls", True, True) On Error GoTo 0 If Not wb2 Is Nothing Then On Error Resume Next For Each ws In wb.Worksheets If ws.Visible Then ws.Select Range("D:F") = "" wb2.Worksheets("Taul2").Range("D:F").Copy Range("D1") ' 2 ekaa riviä hipsaa ylläoleva rivi ja poista hipsu allaolevalta riviltä ' wb2.Worksheets("Taul2").Range("1:2").Copy Range("D1") End If Next wb2.Close False Set wb2 = Nothing End If Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Sub Kopioi2() 'kopioi suljetusta työkirjasta suljettuun työkirjaan Dim wb As Workbook Dim wb2 As Workbook Dim ws As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False On Error GoTo 0 Set wb2 = Workbooks.Open("C:\AA.xls", True, True) If Not wb2 Is Nothing Then Set wb = Workbooks.Open("C:\BB.xls", True, False) If Not wb Is Nothing Then On Error Resume Next For Each ws In wb.Worksheets If ws.Visible Then ws.Select Range("D:F") = "" wb2.Worksheets("Taul2").Range("D:F").Copy Range("D1") ' 2 ekaa riviä hipsaa ylläoleva rivi ja poista hipsu allaolevalta riviltä ' wb2.Worksheets("Taul2").Range("1:2").Copy Range("D1") End If Next End If End If wb2.Close False Set wb2 = Nothing wb.Close True Set wb = Nothing Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

        Hei, Ja ensimmäiseksi kiitos avusta Kunde ja hyvää wappua. Tossa Sub Kopiossa on joku juttu joka ei taida toimia mun excelissä. Kopio2 toimii jos suljen tiedoston käsin, mutta muuten ei. Niinikuin pitää. Eli vähän kertausta. AA tiedosto on se paikka josta haetaan tiedot, joka ei ole auki. BB tiedosto on jo avoin ja siihen tiedostoon kopioidaan kaikille välilehdille D:F tiedot. Menikö oikein? Olisiko mahdollista saada Sub Kopio toimimaan selostuksen kaltaisesti? AA tiedostoa ei tarvita sen jälkeen, että se voisi sulkeutua käytönjälkeen, mutta kopioitavaan tiedosto voisi jäädä auki eli BB tiedosto.

      • hmm...
        hmm... kirjoitti:

        Hei, Ja ensimmäiseksi kiitos avusta Kunde ja hyvää wappua. Tossa Sub Kopiossa on joku juttu joka ei taida toimia mun excelissä. Kopio2 toimii jos suljen tiedoston käsin, mutta muuten ei. Niinikuin pitää. Eli vähän kertausta. AA tiedosto on se paikka josta haetaan tiedot, joka ei ole auki. BB tiedosto on jo avoin ja siihen tiedostoon kopioidaan kaikille välilehdille D:F tiedot. Menikö oikein? Olisiko mahdollista saada Sub Kopio toimimaan selostuksen kaltaisesti? AA tiedostoa ei tarvita sen jälkeen, että se voisi sulkeutua käytönjälkeen, mutta kopioitavaan tiedosto voisi jäädä auki eli BB tiedosto.

        Eli Sub Kopio:ssa ei tapahdu mitään, eli ei tua eikä kopioi BB tiedostoon mitään tietoja. Toivottavasti tämä selkeytti pikkaisen ongelmaa.

      • kunde
        hmm... kirjoitti:

        Eli Sub Kopio:ssa ei tapahdu mitään, eli ei tua eikä kopioi BB tiedostoon mitään tietoja. Toivottavasti tämä selkeytti pikkaisen ongelmaa.

        korjattu viittaus BB työkirjaan Sub Kopioi() 'kopioi suljetusta työkirjasta aktiiviseen työkirjaan Dim wb As Workbook Dim wb2 As Workbook Dim ws As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False Set wb = Workbooks("BB") Set wb2 = Workbooks.Open("C:\AA.xls", True, True) On Error GoTo 0 If Not wb2 Is Nothing Then On Error Resume Next wb.Activate For Each ws In ActiveWorkbook.Worksheets If ws.Visible Then ws.Select ws.Range("D:F") = "" wb2.Worksheets("Taul2").Range("D:F").Copy Range("D1") ' 2 ekaa riviä hipsaa ylläoleva rivi ja poista hipsu allaolevalta riviltä ' wb2.Worksheets("Taul2").Range("1:2").Copy Range("D1") End If Next wb2.Close False Set wb2 = Nothing End If Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Kepp Excelling @Kunde

      • kiitos!!!!
        kunde kirjoitti:

        korjattu viittaus BB työkirjaan Sub Kopioi() 'kopioi suljetusta työkirjasta aktiiviseen työkirjaan Dim wb As Workbook Dim wb2 As Workbook Dim ws As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False Set wb = Workbooks("BB") Set wb2 = Workbooks.Open("C:\AA.xls", True, True) On Error GoTo 0 If Not wb2 Is Nothing Then On Error Resume Next wb.Activate For Each ws In ActiveWorkbook.Worksheets If ws.Visible Then ws.Select ws.Range("D:F") = "" wb2.Worksheets("Taul2").Range("D:F").Copy Range("D1") ' 2 ekaa riviä hipsaa ylläoleva rivi ja poista hipsu allaolevalta riviltä ' wb2.Worksheets("Taul2").Range("1:2").Copy Range("D1") End If Next wb2.Close False Set wb2 = Nothing End If Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Kepp Excelling @Kunde

        Hei, Kiitos. Erittäin ystävällistä.

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

    Takaisin ylös

    Luetuimmat keskustelut

    1. Olen nainen pahoillani, että tykkään sinusta niin paljon, että

      Haluaisin panna sua. Tuntuu vaan siltä, että olet sen suhteen ihan haluton. Ei minulle riitä pelkkä ystävyyssuhde.
      Ikävä
      89
      1398

    2. Puukotus Kajaanissa

      Kuka puukotti ja ketä? https://yle.fi/a/74-20247765 Vähemmän yllättäen päihteet mainittu
      Kajaani
      43
      923

    3. Liikenneonnettumuus

      Linkkari ja ruotsibiili törmäsivät linkku oli redun opetusajossa
      Ylitornio
      13
      837

    4. Mieti oikeasti

      Ollaan lähes tuntemattomia, mutta samalla on tämä erityinen vuosien tilanne takana, joka on ollut monella tapaa väärin.
      Ikävä
      40
      818

    5. Taasko sä vedit

      Suojamoodin päälle? Miehelle
      Ikävä
      91
      720

    6. Pahin tapa satuttaa toista

      On jättää toinen vaille mitään vastausta. Erityisen kipeää se tekee sillon jos toinen ghostaa.
      Ikävä
      81
      720

    7. Tiedoksi yhdelle naiselle

      että mies lähestyy kaikin tavoin jos on kiinnostunut! 🙋🏻‍♂️
      Ikävä
      46
      708

    8. kene ajoi "kolarin"?

      "Punkaharjulla Luston ja Tuppuranmäen välillä sattui tiistaina aamupäivällä liikenneonnettomuus. Poliisin mukaan Savonl
      Savonlinna
      17
      707

    9. Minulla on joskus ikävä sinua ja ajattelen sinua joskus.. edelleen

      Olin joskus niin rakastunut sinuun. Olin onnellinen, että kohdattiin ja kun vain tiesin sinun olevan olemassa. Täytit aj
      Ikävä
      27
      657

    10. Mitä söpö

      Mies mietit?
      Ikävä
      58
      648

    11. Alkaa jotenkin nyt kuvio hahmottuu täällä

      Sellainen vaikutelma tästä alkaa tulla, että täällä on joku pieni porukka, joka tuntee toisensa tai ainakin pelaa samaan
      Ikävä
      97
      641

    12. Tulisitko huomenna mun luo?

      🤗
      Ikävä
      66
      633

    13. Miten uskallan sua nähdä

      Kun vaikutat suuttuneelta :(
      Ikävä
      43
      611

    14. Taas henkirikos

      Kuka lienee nyt asialla.
      Ilomantsi
      10
      578

    15. Nainen, tässä olen kahden vaiheilla

      Toinen pitäisi valita ja kummassakin on hyvät ja huonot puolensa. Toinen olisi sellainen pysyvä mutta työläs. Toinen taa
      Ikävä
      56
      575

    16. Jos kaivattusi on

      Varattu niin miksi et antaisi asian olla hänen suhteen. Miksi ylipäätään vielä jatkat?
      Ikävä
      47
      566

    17. Minä kyllä odotan nainen

      että sinun kanssa voisin jutella asioista ihan oikeasti.
      Ikävä
      43
      544

    18. Hyvä on sitten, jos et sitä s*ksiä halua kanssani.

      Rakastetaan vaan toisiamme, voin käydä muualla tyydyttämässä fyysisenpuolen tarpeet. Puhumalla tämäkin olisi selvinnyt.
      Ikävä
      129
      537

    19. Kylän tielle remonttia?

      Mitäköhän kylän tielle ruvetaan tekemään ku laitettu tuommoset töpsät muutamien suojateitten kohille?
      Hyrynsalmi
      13
      512

    20. Suloinen ja herkkä

      Toiset huomioiva, räväkkä, yllättävä. Ei sellaisesta voi olla pitämättä.
      Rakkaus ja rakastaminen
      31
      505
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt