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?
Kopiointi yhdestä tiedostosta
toisen taulukon välilehtiin?
7
648
Vastaukset
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
S-kauppa nosti hintoja, K-kauppa laski
Elintarvikkeiden arvonlisävero laski vuodenvaihteessa 13,5 prosenttiin. S-kauppa siirsi alennuksen suoraan katteisiin pi675927Vilma Nissinen pyytää anteeksi rasistisia lausuntojaan
Nöyrtyi kuten persut yleensäkin. On kyllä noloa tuollainen vätystely, kun ei ole miestä seisoa omien lausuntojensa takan3495749Hiihtäjä Vilma Nissisen kommentit aiheutti paniikkia
ja hernettä vedettiin nenään. Nissinen kertoi torstaina haastattelussa, kun häneltä kysyttiin, että tykkääkö hän hiihtä934731Huuto yltyy persujen piirissä Venezuelan johdosta.
Kohta kakofonia yltyy kun persut tajuavat mitä Venezuelassa tapahtui. Von den Leydenki jo kipuilee kuten persut EU:ssa y122235Ikävä uutinen uudesta Unelmia Italiassa kaudesta - Iso pettymys tv-katsojille!
Unelmia Italiassa -sarja kertoo Ellen Jokikunnaksen perheen elämästä Suomessa ja Italiassa. Nyt Ellen on kertonut tuleva182048Nyt ottaa persua pattiin: sähköauto joulukuun myydyin
🤣 prööt prööt pakoputkellaan pörisevää persua ottaa nyt saamaristi pattiin, kun paristoilla kulkeva sähköauto on noussu521952Ovatko Perussuomalaiset kommunisteja?
Toiset sanovat että ovat, toiset sanovat että eivät. Ainakin heillä on paljon sen aatteen piirteitä, koska haluavat kont431870Martina vuokraa yksiötä
Nyt on tarkka'ampujan yksiö vuokrattavana 800 e. Toivottavasti löytyy hyvä asukas.2511211Jokaisella tytöllä on supervoimansa
Millaisia ajatuksia artikkeli herättää? Mainos: Dove | ”Itsetuntoni oli ihan romuttunut” – Peppina Rosén haastaa tavan2031114Voi kauhiaa: keikkapaikat keikahtavat juopottelun puutteessa!
Vai ei tule rahaa artistille viinanmyynnin vähennyttyä. Missähän muualla kannattavuus korreloi myrkyn imemismäärän ka641061