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

642

Äänestä

    Vastaukset

    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. Mieleni harhailee sinussa

      Uskon että tykkäät minusta. On vain yksi elämä. Silti jään paikoilleni ja odotan että jokin muuttuu. Menin palasiksi, ei
      Tunteet
      9
      1732

    2. Toivotko, että

      hän tulisi juttelemaan sinulle, vai lähestytkö mieluummin itse?
      Ikävä
      89
      1175

    3. Jännitän sinua J mies

      Ei tästä tulee mitään. Tuskin kaikki olis mennyt näin moneen solmuun, jos olis tarkoitettu meidät yhteen.
      Ikävä
      118
      1166

    4. Kuinka kauan kesti että ihastuit

      Kaivattuusi? Jos lasketaan siitä hetkestä alkaen kun näit hänet ensi kerran. Oliko jokin tilanne tai tapahtuma, joka voi
      Ikävä
      51
      973

    5. Olen käyttäytynyt sinua kohtaan väärin toistuvasti

      Puolustuksekseni täytyy sanoa, että ei ole ollut tahallista vaan seurausta harhaisista luuloista ja ajatuksista. Esimerk
      Ikävä
      63
      874

    6. Orpo suunnittelee palestiinalaislasten Suomeen siirtoa

      "Sairaalahoitoa tarvitsevien lasten ottaminen Suomeen on lisäksi selvityksessä, Orpo sanoo. – Jos meillä on mahdolli
      Maailman menoa
      209
      844

    7. Tunneälyä testaamaan!

      Testi pitää sisällään viisi osa-aluetta. Itse sain täydet tuosta ensimmäisestä eli 25/25. Kokonaispistemäärä oli 100/125
      Lesbot
      3
      756

    8. Vaikutat tosi mielenkiintoiselta ja

      paksulta. 😂 m - n
      Ikävä
      81
      753

    9. solmussa solmussa

      Tilanne solmussa. Umpisommussa🫢
      Ikävä
      35
      699

    10. Saanko mies tulla sun kainaloon nukkumaan?

      En saa unta kun mietin sua❤️ Saako tulla sun viereen ja käpertyä sun kainaloon?
      Ikävä
      42
      653
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt