Gemme data i to forskellige excelfiler/Sende data til excelfil

Skal du bruge koden i 2 forskellige filer eller skal du "blot" have kopieret arket Data fra fil 1 til C:\test.xls?

Option Base 1
Const kildeSti = "C:\test.xls"      'tilpasses

Public Sub tt()
    Dim Data(15) As Variant
    Data(1) = txtDato.Value
    Data(2) = cboKlok.Value
    Data(3) = cboMaskine.Value
    Data(4) = txtVarenummer.Value
    Data(5) = txtPlade.Value
    Data(6) = txtPladeordre.Value
    Data(7) = txtOrdrenummer.Value
    Data(8) = txtArbejdsnr.Value
    Data(9) = txtArbejdsnr2.Value
    Data(10) = txtEmner.Value
    Data(11) = txtKasserede.Value
    Data(12) = cboFejltype.Value
    Data(13) = txtBemaerkning.Value
    Data(14) = "Mekanik"
    Data(15) = "PC XX"

    Set kXLS = CreateObject("Excel.application")
    With kXLS
        .Workbooks.Open kildeSti
        ' skriver
        .Sheets("Data").Range(.Sheets("Data").Range("A65536").End(xlUp).Offset(1, 0), .Sheets("Data").Range("A65536").End(xlUp).Offset(1, 14)) = Data
       
        .ActiveWorkbook.Close SaveChanges:=True ' gemmer og lukker
        .Application.Quit
    End With
    Set kXLS = Nothing
End Sub

Ok hvis den skal skrive begge steder, så

Option Base 1
Const kildeSti = "C:\test.xls"      'tilpasses

Public Sub Gem()
    Dim Data(15) As Variant
    Data(1) = txtDato.Value
    Data(2) = cboKlok.Value
    Data(3) = cboMaskine.Value
    Data(4) = txtVarenummer.Value
    Data(5) = txtPlade.Value
    Data(6) = txtPladeordre.Value
    Data(7) = txtOrdrenummer.Value
    Data(8) = txtArbejdsnr.Value
    Data(9) = txtArbejdsnr2.Value
    Data(10) = txtEmner.Value
    Data(11) = txtKasserede.Value
    Data(12) = cboFejltype.Value
    Data(13) = txtBemaerkning.Value
    Data(14) = "Mekanik"
    Data(15) = "PC XX"
   
    ' skriver lokal
    Sheets("Data").Range(Sheets("Data").Range("A65536").End(xlUp).Offset(1, 0), Sheets("Data").Range("A65536").End(xlUp).Offset(1, 14)) = Data

    Set kXLS = CreateObject("Excel.application")
    With kXLS
        .Workbooks.Open kildeSti
        ' skriver ekstern
        .Sheets("Data").Range(.Sheets("Data").Range("A65536").End(xlUp).Offset(1, 0), .Sheets("Data").Range("A65536").End(xlUp).Offset(1, 14)) = Data

        .ActiveWorkbook.Close SaveChanges:=True    ' gemmer og lukker
        .Application.Quit
    End With
    Set kXLS = Nothing
End Sub

Hej Kabbak
Erstatter den kode du har lavet, den jeg havde i forvejen - altså gemmer den både i den fil der er åben og den man definerer stien til? Søger den også efter den første ledige række i arket "Data"? Hvordan benytter jeg koden?

Har fået koden sat op, men den overskriver istedet for at oprette en ny række.

Den virker fint her, og overskriver ikke, men sætter det på nederste tomme linje.

Koden kræver at der altid er data i A kolonnen, i begge Data ark, der er "txtDato.Value", som ikke må være tom

"men sætter det på nederste tomme linje"

skulle være

men sætter det på den tomme linje, lige under eksisterende data

Åh, det er fordi den starter med at indsætte data, i form af dato, i kolonne B. Har det noget med Offsettet at gøre?

har du dette med øverst

Option Base 1
Const kildeSti = "C:\test.xls"      'tilpasses

det skal være der

Option Base 1, betyder at data(x) skal starte med 1 og ikke 0, som den gør når der ikke står noget.

Nej, den havde jeg ikke med. Nu får jeg en compile error på linien "Option Base 1".

Det skal være i toppen af modulet, helt uden for koden

Super - nu virker det!! Send et svar.

et svar ;-))

Er det muligt at låse det art hvor data bliver lagret - altså så brugeren kan se data, men ikke ændre dem. Det er kun det dataark som formen ligger i der ønskes låst ikke det der sendes til.

Du kan beskytte arket via kode

  ' skriver lokal
Sheets("Data").Unprotect Password:="Test"
    Sheets("Data").Range(Sheets("Data").Range("A65536").End(xlUp).Offset(1, 0), Sheets("Data").Range("A65536").End(xlUp).Offset(1, 14)) = Data
Sheets("Data").Protect Password:="Test"

Endnu engang tak!!