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

637

Ää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. Hengenvaaralliset kiihdytysajot päättyivät karmealla tavalla, kilpailija kuoli

      Onnettomuudesta on aloitettu selvitys. Tapahtuma keskeytettiin onnettomuuteen. Tapahtumaa tutkitaan paikan päällä yhtei
      Kauhava
      198
      6908

    2. Ootko rakastunut?

      Kerro pois nyt
      Ikävä
      159
      2036

    3. Onhan sulla nainen parempi mieli

      Nyt? Ainakin toivon niin.
      Ikävä
      113
      1688

    4. Ujosteletko tosissaan vai mitä oikeen

      Himmailet???? Mitä pelkäät?????
      Ikävä
      51
      1390

    5. Suureksi onneksesi on myönnettävä

      Että olen nyt sitten mennyt rakastumaan sinuun. Ei tässä mitään, olen kärsivällinen ❤️
      Ikävä
      55
      1238

    6. Möykkähulluus vaati kuolonuhrin

      Nuori elämä menettiin täysin turhaan tällä järjettömyydellä! Toivottavasti näitä ei enää koskaan nähdä Kauhavalla! 😢
      Kauhava
      50
      1098

    7. Älä mies pidä mua pettäjänä

      En petä ketään. Älä mies ajattele niin. Anteeksi että ihastuin suhun varattuna. Pettänyt en ole koskaan ketään vaikka hu
      Ikävä
      100
      1074

    8. Reeniähororeeniä

      Helvetillisen vaikeaa työskennellä hoitajana,kun ei kestä silmissään yhtään läskiä. Saati hoitaa sellaista. Mitä tehdä?
      Kouvola
      7
      996

    9. Tarvitsemme lisää maahanmuuttoa.

      Väestö eläköityy, eli tarvitsemme lisää tekeviä käsiä ja veronmaksajia. Ainut ratkaisu löytyy maahanmuutosta. Nimenomaan
      Maailman menoa
      251
      954

    10. Kävit nainen näemmä mun

      Facessa katsomassa....
      Ikävä
      41
      929
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt