Overfør data fra åbent regneark til lukket rengeark

Hvor kommer pop-up'en fra?

Måske kan du beskrive omstændighederne lidt mere.

Jeg kan prøve, pop-up'en kommer fra det program vi har fået som hedder EDH. Den kommer frem hver gang man lukker et af office programmerne, og så er det den kommer frem med den pop-up og stopper min kode.

Lige nu åbner vores medarbejdere et spørgeskema (excel ark), de udfylder det og trykker på en knap som starter min kode:

Sub IndsendSvar()

Dim wBook As Workbook
Dim Tekst As String
Dim SAND As Range
Dim SH As Worksheet

Sheets("Data").Visible = True
Sheets("data").Select

Tekst = "Der kan kun indsendes et svar af gangen." & vbNewLine
Tekst = Tekst & "Vent 10 sekunder og prøv derefter igen."

On Error Resume Next

Set wBook = Workbooks("NIX PILLE.xls")
       
        If wBook Is Nothing Then 'Not open
            Sheets("Data").Select
            Range("C1:C39").Select
            Selection.Copy
   
            Workbooks.Open Filename:= _
                "H:\01 Fælles\YDS - MEKS\Administration\NIX PILLE.xls"
            Sheets("Svar").Select
            Range("A1").Select
            ActiveCell.Select
            Selection.End(xlDown).Select
            ActiveCell.Offset(1, 0).Range("A1").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Application.CutCopyMode = False
            Selection.Sort Key1:=ActiveCell, Order1:=xlDescending, Header:=xlGuess, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                DataOption1:=xlSortNormal
            Sheets("Registreringer").Select
            Range("A1").Select
            ActiveCell.Select
            Selection.End(xlDown).Select
            ActiveCell.Offset(1, 0).Range("A1").Select
            ActiveCell.FormulaR1C1 = "1"
               
            ActiveWorkbook.Save
            ActiveWindow.Close
           
            Range("B1").Select
           
                For Each SAND In Range("B1:B52")
                SAND = False
                Next SAND
         
            Sheets("1").Visible = True
           
            Sheets("11").Visible = True
            Sheets("11").Select
            Range("D6").Select
            ActiveCell.FormulaR1C1 = "SKRIV HER HVILKET BREV DET DREJER SIG OM"
           
            Sheets("13").Visible = True
            Sheets("13").Select
            Range("D11").Select
            ActiveCell.FormulaR1C1 = "VÆLG FRA RULLELISTE"
            Range("D14").Select
            ActiveCell.FormulaR1C1 = "VÆLG FRA RULLELISTE"
           
            Sheets("14").Visible = True
            Sheets("14").Select
            Range("D7").Select
            Selection.ClearContents
                       
            Sheets("1").Select
           
                For Each SH In Sheets(Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, "Data"))
                SH.Visible = False
                Next SH
                   
            Sheets("Data").Visible = False
           
            MsgBox "Dit svar er indsendt.", vbOKOnly, "Sendt"
               
            Set wBook = Nothing
            On Error GoTo 0
        Else 'It is open
            MsgBox Tekst, vbOKOnly + vbInformation, "Vent et øjeblik"
            Set wBook = Nothing
            On Error GoTo 0
        End If
End Sub

Og i koden hvor den lukker og gemmer NIX PILLE arket, kommer pop-up'en frem. og når man her så trykker "Gem lokalt" stopper koden.

Er det et eller flere ark der i givet fald skulle gemmes i en "lukket" fil? Den "lukkede fil" åbnes & gemmes som object - om det vil forhindre PopUp'en - ?? - kender ikke til elektronisk dokumenthåndtering i praksis.

Hvad spørges der om i omtalte PopUp?

det er et område der skal område fra et ark der skal gemmes i den lukkede fil. Jeg er ikke den store VBA haj på dette område, så ved ikke hvordan, ved bare at ovenstående kode ikke virker.

Pop-up'en kommer med tre punkter man kan vælge imellem:
1. Gem dokument i EDH
2. Gem lokalt
3. Fortsæt med at lukke dokumentet

Noget i den stil.

D.v.s hvis det aktuelle ark bliver gem i en lukket fil?

Kigger lidt mere på din kode - når der bliver lidt tid...

Hvis det kan bliver gemt i en fil som er lukket ja, så vil jeg tro at jeg kan undgå pop-ip'en, da den jo kommer frem når man vil lukke et ark.

OBS - object-filen skal åbnes - men det er ikke på normal vis.

Men måske ville det være en god ide at konstruere en lille model først.

For at få det helt tydeligt. Når du er færdig med excel-arket - er det så når du gemmer / lukker, der popes eller??

Eller afslutter I via en bestemt knap eller?

Den aktiveres ved at man trykker i krydset i højre hjørne, men i koden er det jo noget VBA gør, ved at benytte activeworkbook.close

Jeg kender ikke noget til Object-filer, desværre.

Pop-up'en kommer frem når man trykker på krydset i højre hjørne. Men når jeg kører min kode, aktiveres den af ActiveWorkbook.Close

Hvis du sender en mail - så returnerer jeg en model. @-adr. under profil.

Skulle det ikke virke - så kan man skrive (append'e) i en tekst-fil, som så senere kan importeres i Excel.

Test-koden:

Sub overførTilLukket()
Dim objX As Object
Dim antalRæk As Long
Dim antalKol As Byte
Dim xsti As String
    xsti = ActiveWorkbook.Path
    If Right(xsti, 1) <> "\" Then
        xsti = xsti + "\"
    End If
   
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
    antalKol = ActiveCell.SpecialCells(xlLastCell).Column
   
    Range(Cells(1, 1), Cells(antalRæk, antalKol)).Select
    Selection.Copy
   
    Set objX = CreateObject("Excel.Application")
    With objX
Rem    .Visible = True
        .Workbooks.Open xsti + "lukket.xls"
        .ActiveWorkbook.Sheets(1).Activate
        .Cells(1, 1).Select
       
        .ActiveSheet.Paste
       
        .ActiveWorkbook.Save
        .Application.Quit
    End With
   
    Set objX = Nothing
    Application.CutCopyMode = False
End Sub