Kopier SheetX til SheetY,hvor arkene ligger i hver deres workbook

Sub Demo()
    Sheets("Ark2").UsedRange.ClearContents
    Sheets("Ark1").UsedRange.Copy
    Sheets("Ark2").Range("A1").PasteSpecial xlPasteAll
End Sub

Ovenstående er skrevet i frihåndsredigering, så der kan være fejl.

Hej Flemming.
Kræver din løsning ikke, at sheets ligger i samme workbook? Det gør de nemlig ikke. De kan til nød ligge i samme mappe (fx. c:\excel\book1.xls og c:\excel\book2.xls).
Mvh
Mads

jo det har du ret i....
kan du nøjes med at overskrive det andet ark?

Hej Flemming.
Nej desværre, da book1 indeholder en masse andet data i en række andre sheets.
Mads

ikke testet

Sub Demo()
    Const sFILE_TO As String = "C:\Excel\Book2.xls"
    Const sSHEET_TO As String = "Til arknavnet"
    Const sSHEET_FROM As String = "Fra arknavnet"
    Dim wbFrom As Workbook
    Dim wbTo As Workbook
   
    Set wbFrom = ThisWorkbook
    On Error GoTo ProgErr
    Set wbTo = Application.Workbooks.Open(Filename:=sFILE_TO)
   
    wbTo.Worksheets(sSHEET_TO).UsedRange.ClearContents
    wbFrom.Worksheets(sSHEET_FROM).UsedRange.Copy
    wbTo.Worksheets(sSHEET_TO).Range("A1").PasteSpecial xlPasteAll

    GoTo CleanUp

ProgErr:
    MsgBox "Workbook or sheet not found - no copy made", _
          vbExclamation + vbOKOnly, "Systeminformation"

CleanUp:
    On Error GoTo 0
    wbTo = Nothing
    wbFrom = Nothing
End Sub

Hej Flemming.
Den hopper direkte til fejlbeskeden, og ender med Book2 i fokus og indholdet er markeret.
Mads

Har du ændret arknavnene? til nogle arknavne der findes?

    Const sSHEET_TO As String = "Til arknavnet"
    Const sSHEET_FROM As String = "Fra arknavnet"

Prøv evt. denne
Indsæt i destinations filen, i et modul

Sub Kopier()
Sheets("Ark1").UsedRange.Delete
Workbooks.Open Filename:="c:\Temp\Kvartil.XLS" ' Ret til aktuel mappe filnavn *
Workbooks("Kvartil").Worksheets("Ark1").Range("A1:iv300").Copy ' Ret til aktuel fil, ark navn *
Workbooks("KopierTil").Worksheets("Ark1").Activate ' Ret til aktuel fil, ark navn *
Range("A1").Activate
ActiveCell.PasteSpecial
Workbooks("Kvartil.xls").Close savechanges:=False ' Ret til aktuel ark navn *
[A1].Select
End Sub

Sheets("Ark1").UsedRange.Delete ' skal også rettes til aktuel destinationsark navn

Testet så det virker - husk at ændre sti, filnavn samt arknavnene

Sub Demo()
    Const sFILE_TO As String = "C:\Excel\Book2.xls"
    Const sSHEET_TO As String = "Sheet1"
    Const sSHEET_FROM As String = "Sheet1"
    Dim wbFrom As Workbook
    Dim wbTo As Workbook
    Dim lTemp As Long
   
    Set wbFrom = ThisWorkbook
    On Error GoTo ProgErr
    Set wbTo = Application.Workbooks.Open(Filename:=sFILE_TO)
   
    wbTo.Worksheets(sSHEET_TO).UsedRange.ClearContents
    ' The next line does nothing but correct a bug in Excel about UsedRange
    lTemp = wbFrom.Worksheets(sSHEET_FROM).UsedRange.Rows.Count
    wbFrom.Worksheets(sSHEET_FROM).UsedRange.Copy
    wbTo.Worksheets(sSHEET_TO).Range("A1").PasteSpecial xlPasteAll

    GoTo CleanUp

ProgErr:
    MsgBox "Workbook or sheet not found - no copy made", _
          vbExclamation + vbOKOnly, "Systeminformation"

CleanUp:
    On Error GoTo 0
    Application.CutCopyMode = False
    Set wbTo = Nothing
    Set wbFrom = Nothing
End Sub

-->excelent.
Jeg kan ikke få dit eksempel til at virke - måske jeg ikke bruger det korrekt (ved du at det virker)?

-->flemmingdahl.
Jeg kan godt få dit eksempel til at virke, men ikke helt efter hensigten. Jeg har ikke fået forklaret mig korrekt, det er uhensigtsmæssigt og det beklager jeg. Tilfældet er det, at jeg via en knap i sheet8 i book1.xls skal hente data fra sheet2 i book2.xls og indsætte i sheet9 i book1.xls. Har prøvet at omforme dit eksempel, men uden held.

Mvh
Mads

'ja det virker ok her :-)
'Indsæt kode i et modul i Book1.xls (Book2.xls skal ikke være åbnet når makro køres)

Sub Kopier()
Sheets("Sheet9").UsedRange.Delete
Workbooks.Open Filename:="c:\Mappenavn\Book2.XLS" ' Ret til aktuel sti *
Workbooks("Book2").Worksheets("Sheet2").Range("A1:iv300").Copy ' ret evt. område *
Workbooks("Book1").Worksheets("Sheet9").Activate
Range("A1").Activate
ActiveCell.PasteSpecial
Application.CutCopyMode = False
Workbooks("Book2.xls").Close savechanges:=False
[A1].Select
End Sub

ikke testet

Sub Demo()
    Const sFILE_GET As String = "C:\Excel\Book2.xls"
    Const sSHEET_GET As String = "Sheet2"
    Const sSHEET_INSERT As String = "Sheet9"
    Dim wbGet As Workbook
    Dim wbInsert As Workbook
    Dim lTemp As Long
   
    Set wbInsert = ThisWorkbook
    On Error GoTo ProgErr
    Set wbGet = Application.Workbooks.Open(Filename:=sFILE_GET)
   
    wbInsert.Worksheets(sSHEET_INSERT).UsedRange.ClearContents
    ' The next line does nothing but correct a bug in Excel about UsedRange
    lTemp = wbFrom.Worksheets(sSHEET_GET).UsedRange.Rows.Count
    wbInsert.Worksheets(sSHEET_GET).UsedRange.Copy
    wbGet.Worksheets(sSHEET_INSERT).Range("A1").PasteSpecial xlPasteAll

    GoTo CleanUp

ProgErr:
    MsgBox "Workbook or sheet not found - no copy made", _
          vbExclamation + vbOKOnly, "Systeminformation"

CleanUp:
    On Error GoTo 0
    Application.CutCopyMode = False
    Set wbGet = Nothing
    Set wbInsert = Nothing
End Sub

excelent:
Jeg får en fejl i denne linie : Workbooks("Book2").Worksheets("Sheet2").Range("A1:iv100").Copy ' ret evt. område *
Jeg har rettet stien til, har også prøvet at lægge den i c:\Book2.xls for at se om Excel hadve problemer med mellemrum i mappenavne mv. Men det virker fortsat ikke.

Flemmingdahl:
Jeg får en fejl på denne linie:
lTemp = wbFrom.Worksheets(sSHEET_GET).UsedRange.Rows.Count
Hvis jeg udkommenterer den og kører igen, så kommer Book2.xls i fokus og alt indhold er markeret - men der sker ikke mere?

<skal nok smide fuld point i puljen, I bruger meget tid/energi her, og det er jeg glad for>

nu ved jeg ikke hvor stort område du har data i, men prøv evt. at ændre det til
Workbooks("Book2").Worksheets("Sheet2").Range("A1:EV100").Copy ' ret evt. område *
eller mindre hvis muligt

vi skal nok få det til at virke :-)

selv hvis jeg ændrer Range til A1:M50 får jeg fejl i den linie.
Det er en runtime error "9"
Subscrift out of Range

Jeg er ved godt mod og er fortrøstningsfuld :-)

kan du evt paste din kode her, så kan vi kikke nærmere på den ?

yes, selvfølgelig.

--------------
Sub Kopier()
Sheets("Sheet3").UsedRange.Delete
Workbooks.Open Filename:="C:\Book2.XLS" ' Ret til aktuel sti *
Workbooks("Book2").Worksheets("Sheet2").Range("A1:M50").Copy ' ret evt. område *
Workbooks("Book1").Worksheets("Sheet3").Activate
Range("A1").Activate
ActiveCell.PasteSpecial
Application.CutCopyMode = False
Workbooks("Book2.xls").Close savechanges:=False
[A1].Select
End Sub

--------------------

virker mystisk da der ikke er variabler i koden

prøv skift denne ud
Sheets("Sheet3").UsedRange.Delete
med
Sheets("Sheet3").Range("A1:IV300").Delete

Ellers prøv åbne begge ark og kør denne kode:

Sub KopierArk()

Workbooks("Book1").Worksheets("Sheet3").Activate
Sheets("Sheet3").UsedRange.Delete
Range("A1").Activate
Workbooks("Book2").Worksheets("Sheet2").Range("A1:M50").Copy Destination:=ActiveCell
Application.CutCopyMode = False
[A1].Select

End Sub

Denne er meget lig Excelents kode, men den kopierer istedet usedrange og dermed undgås subscript out of range forhåbentlig.


Sub kopier_workbook()

Worksheets("Sheet3").UsedRange.Delete
Workbooks.Open Filename:="C:\Book2.xls"
Workbooks("Book2").Worksheets("Sheet2").UsedRange.Copy _
Destination:=Workbooks("Book1").Worksheets("Sheet3").Range("a1")
Workbooks("Book1").Worksheets("Sheet3").Columns.AutoFit
Workbooks("Book2").Close savechanges:=False

End Sub

hej mrjh har du prøvet min kode ? og i såfald får du også den samme fejl ?

Hej Excelent. Nej jeg får ingen fejl når jeg prøver din kode, så det var åbenbart ikke usedrange som løste det. Måske er det filnavnet som ikke er korrekt og som derfor er "out of range", eller måske et af arknavnene som ikke eksisterer. Ellers er gode råd dyre :-)

lol

Hej.
Jeg får fortsat fejl, desværre.
Jeg har nu prøvet på 2 forskellige pc'ere med samme resultat. Jeg har forsøgt at slette + genoprette excel-dokumenterne igen (Book1 og Book2). Jeg er 100 % sikker på, at både filnanve og arknanve eksisterer :-)

Er der mere at prøve (hope so).
mads

har du prøvet koden fra kommentar 17:57:20 (med begge ark åbne) ?

Ja, så får jeg fejl i denne linie:
Workbooks("Book1").Worksheets("Sheet3").Activate

Er der nogle specielle indstillinger mv. jeg skal have slået til/fra? Det lyder jo usandsynligt, at det ikke virker på mine 2 pc'ere, men at det virker fint på Jeres? Den jeg arbejder med her er med en engelsk Office-pakke....

Mads

hmm ja den er svær, mig bekendt er der ikke noget der skal slåes til el. fra
og min version er godt nok Dansk 2003, men i VBA er det jo underordnet.

et skud i tågen har du beskyttet dine ark, låste celler, -eller evt delte (shared) projektmapper el. lign. ?

Ikke noget jeg er bevidst om i hvert fald. Jeg har netop for at undgå sådanne faktorer bare højreklikket i c:\ og oprettet 2 tomme excelark med de omtalte navne. Skrevet henholdsvis Book1 og Book2 i en celle i hvert ark (for at kunne se hvis det lykkedes), kopieret Jeres eksempler ind i VBA editoren(alt+F11), og dereter enten kørt makroen fra Book1 via alt+f8 eller indsat en knap med tilknytning til de forskellige eksempler.
Mads

Og der er Sheet2 og Sheet3 som arknavne i filerne ?

prøv lige med denne tilretning

Sub KopierArk()

Workbooks("Book1").Activate
WorkSheets("Sheet3").Activate
WorkSheets("Sheet3").Range("A1:M50").Delete
Range("A1").Activate
Workbooks("Book2").Worksheets("Sheet2").Range("A1:M50").Copy Destination:=ActiveCell
Application.CutCopyMode = False
[A1].Select

End Sub

Yes, helt standard navngivning i et nyopretter excelark...
Har I evt. nogle idéer til, om vi kan prøve nogle mindre/andre kodestykker for at se hvor det går galt?
Mads

obs: med begge ark åbne

ja fik samme ide 5floor, så prøv lige 13:02:47

har fjernet den med 'usedrange', kan godt drille en del somtimes

Så får jeg fejl i denne linie:
Workbooks("Book1").Activate
Er det ikke lidt underligt? Det er da en super simpel og typisk kodelinie?

Mads

Med fejl mener jeg, den linie vba-editor markerer med gult og sætter en pil ud for....

og begge ark er åbne

prøv lige at klik i ordet Workbooks og så tryk F1
for at se om din version genkender kommandoen

Så viser den Workbooks properties og tilsvarende med Worksheets.

når du opretter et nyt regneark, er der så mellemrum mellem Sheet og 1 tal ?

i akr navnene

nej de hedder: Sheet1 osv.(uden mellemrum)

Prøv evt. indeksnumre og se om de også fejler
Workbooks(1).Activate
Worksheets(2).Activate

så har vi fat i noget - det virker...

lol, det tyder også på det var noget galt med navnene

Ja åbenbart :-)
Vær opmærksom på at indeksene virker på alle åbne filer

det forstår jeg bare ikke....http://clasix.users.whitehat.dk/untitled.JPG
Sådan ser arket ud?

mrjh> hvis man indlæser flere regneark, er det først indlæste så Workbook(1)
næste Workbook(2) eller hur ?

...og hvorfor virker den direkte reference hos Jer og ikke hos mig?
Jeg ville stærkt foretrække at henvise direkte og ikke være afhængig af, i hvilken rækkefølge/hvilke ark der er åbne når makroen afvikles.

godt spørgsmål 5floor, men jeg er helt ening

har du fået skruet den sammen, eller skal du have et bud/førsøg ?

Prøver :-)
Men det lykkedes ikke rigtig.
Vil være glad for et forsøg (hvis jeg da på nogen måde kan tillade mig at bruge mere af Jeres tid).

no problemo vi er stædige som ind i h.... :-) skal lige ha den til at virke lol

Super, det er jeg glad for.

sjovt nok så får jeg de fejl du gjorde ved brug af indeksnr.
arbejder på sagen

prøv lige min version- er kun delvist brugt indeks.nr. for at få den til at virke
obs. har kaldt den Book1X.xls , så den ikke konflikter med din Book1.xls
så enten ret i koden eller skift filnavn

http://pmexcelent.dk/Book1X.xls

Så får jeg en fejl her: Workbooks("Book2").Worksheets("Sheet2").Range("A1:M50").Copy

hjæææælp :-)

Jeg melder mig lige fra - jeg bliver jo spammet med mails fra dette spørgsmål.

Helt ok Flemming, din løsning så ellers spændende ud...
Jeg lader spørgsmålet stå åbent lidt endnu - håber det ender med en brugbar løsning.
God påske.
Mads

Nå 5floor problemet er ikke forsvundet i nattens løb lol :-)
Jeg kan ikke finde fejl i de forslag vi hidtil er kommet med,
de burde virke (det tyder altså på at det er forhold hos dig som
forhindrer en problemfri afvikling af koderne).

Jeg har ikke meget nyt på tapetet men du kan evt. prøve:

1. Ændre arknavne i den ene workbook, så de ikke er ens
2. evt. dele linierne op i små bidder fx.
  Workbooks("Book2").Worksheets("Sheet2").Range("A1:M50").Copy deles til
  Workbooks("Book2").Activate
  Worksheets("Sheet2").Activate
  Range("A1:M50").Copy
3. Eksperimentere med indeks nr. (jeg har ikke helt styr på dette endnu)

jeg vender tilbage, hvis jeg får nogen ideer.

Hvad Excel version kører du med ?

Hej.
Jeg kan fortsat ikke få det til at virke efter hensigten.
Jeg vil gerne takke for Jeres tid og energi. Læg venligst svar, så tildeler jeg Jer point (har lige opjusteret pointsum).
Mvh
Mads

hej 5floor.- har heller ikke glemt dit problem, men desværre ingen løsning endnu :-)

Jeg springer over Pointene i denne omgang. Det er vist excelent som har brugt mest tid her og fortjener P.
Jeg kan heller ikke forstå at det ikke virker, men håber at du får det løst :-)

ok takker :-)

Endnu en gang tak for tiden og energien.
Mvh
Mads

Endnu engang tak for tiden og energien.
Mvh Mads

Endnu engang tak for tiden og energien.
Mvh Mads

Endnu engang tak for tiden og energien.
Mvh Mads

Endnu engang tak for tiden og energien.
Mvh Mads

Hej Mads - prøv lige om denne virker

Sub Kopier()
 
  Sheets("Sheet3").UsedRange.Delete
  Workbooks.Open Filename:="C:\Book2.XLS" ' Ret til aktuel sti *
  Sheets("Sheet1").Select ' Ret til aktuel ark
  Range("A1:M50").Select ' Ret til aktuel område
  Selection.Copy
  Windows("Book1").Activate ' Ret til aktuel
  Sheets("Sheet3").Select ' Ret til aktuel
  Range("A1").Select ' Ret til aktuel
  ActiveSheet.Paste
  Range("a1").Select
  Windows("book2").Activate ' Ret til aktuel
  Range("a1").Select
  Application.CutCopyMode = False
  ActiveWindow.Close

End Sub