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

621

    Vastaukset

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


      • 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.


      • 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ä.

    Luetuimmat keskustelut

    1. Mikä on kaivattusi etunimi?

      Otsikossa siis on kysymys eriteltynä. Vain oikeat vastaukset hyväksytään.
      Ikävä
      153
      3010
    2. En kestä katsoa

      Sitä miten sinusta on muut kiinnostuneita. Olen kateellinen. Siksi pitäisi lähteä pois
      Ikävä
      95
      1614
    3. Anna minulle anteeksi

      Anna minulle anteeksi. Minä pyydän.
      Ikävä
      143
      1537
    4. Kun viimeksi kohtasitte/näitte

      Mitä olitte tekemässä? Millainen ympäristö oli? Löydetään toisemme...
      Ikävä
      124
      1435
    5. Peräti 95 % persujen kannattajista rasisteja

      Kertoo EVA:n teettämä kysely. Pakollista yhdenvertaisuuskoulutusta tarvitsee siis paljon laajempi joukko kuin pelkästää
      Maailman menoa
      374
      1423
    6. Olet kyllä vaarallisen himokas

      Luova, kaunis, määrätietoinen, pervo, mielenkiintoinen, kovanaama, naisellinen ja erikoinen.
      Ikävä
      99
      1225
    7. Anna vielä vähän vihreää valoa

      Teen sitten siirtoni, nainen. Tiedän, että olet jo varovaisesti yrittänyt lähestyä, mutta siitä on jo aikaa. Jos tunnet
      Ikävä
      15
      941
    8. On minulla suunitelma

      Siitä ei vain tiedä kukaan muu kuin tällä hetkellä minä. Suunnitelma ja varasuunnitelma. Sinun takiasi nainen. Vain s
      Ikävä
      48
      862
    9. Palstan ylivoimaisesti suosituin keskustelunaihe

      Palstan suosituin keskustelunaihe näyttää olevan homoseksuaalisuus. Otsikoiden perusteella voisi kuvitella olevansa Seks
      Luterilaisuus
      259
      815
    10. 60
      805
    Aihe