rabib vba kodo za shranjevanje v bin (iz excella)

Pozdravljeni!
V excelu imam napisan en programček za avtomatsko obdelavo podatkov v bin datoteki.
Datoteka je velika 512 Bytov in na netu sem našel kodo za odpiranje/prenos podatkov v excell (Ta koda mi lepo zloži vsak byte (kot decimalno število) v svojo vrstico)

Private Sub CommandButton1_Click()
Dim intFileNum, bytTemp As Byte, intCellRow%
intFileNum = FreeFile
intCellRow = 0
FileName = Application.GetOpenFilename
If Not FileName = "False" Then MsgBox FileName
Open FileName For Binary Access Read As intFileNum
Do While Not EOF(intFileNum)
intCellRow = intCellRow + 1
Get intFileNum, , bytTemp
Cells(intCellRow, 1) = bytTemp
Loop
Close intFileNum
End Sub

Po končani obdelavi podatkov bi pa želel shranit rezultate oz spremembe v novo datoteko, oz...
bi rabil še kodo ki bi mi omogočila da obdelane podatke iz celic shranim nazaj v bin datoteko torej vseh 512 vrstic bi rad shranil nazaj v novo datoteko po zaporedju od 1 do 512 vrstice. (Torej da se ohrani enak format in velikost datoteke - 512 Bytov)
Please :)

Amacar hvala! Dela skoraj perfektno, res je da moja prejšnja koda doda 513 vrstico z vrednostjo 0, ki je pri obdelavi sploh ne uporabljam, in ravno tale 513 mi sedaj dela težavo pri shranjevanju namreč dobim 513 Bytov. Lahko mogoče prilagodiš tvojo kodo da naj shrani samo prvih 512 vrstic? Lp

Hvala!
Dela super sedaj!
Lp!

Za pravo vsoto se da vse zmenit

Sub naloziBin()
Dim intFileNum, bytTemp As Byte, intCellRow%
intFileNum = FreeFile
intCellRow = 0
Filename = Application.GetOpenFilename
If Not Filename = "False" Then MsgBox Filename
Open Filename For Binary Access Read As intFileNum
Do While Not EOF(intFileNum)
intCellRow = intCellRow + 1
Get intFileNum, , bytTemp
Sheets(2).Cells(intCellRow, 1) = bytTemp
Loop
Close intFileNum
End Sub


Sub shraniBin()
    Dim path As Variant
    Dim stevec As Integer
    Dim nFileNum As Integer
     
    path = Application.GetSaveAsFilename
    If path <> False Then
        nFileNum = FreeFile
        Open path For Binary Lock Read Write As #nFileNum
        stevec = 1
        While stevec < 513
            Put #nFileNum, , CByte(Sheets(3).Cells(stevec, 1))
            stevec = stevec + 1
        Wend
        Close #nFileNum
    End If
End Sub