Data frå anna excelfil og autmatisk lagring

[pakbus]

Har ei excelfil "fil1.xls" med mykje data i. Har ei anna fil "fil2.xls" som er ein slags mal, kor eg har oppretta ein knapp og tilegna ein makro.

 

Ønsker at denne funksjonen åpnar fil1 og hentar ut A2, B2, C2 og sett desse verdiane inn i faste felt etc B4, K8, L9. Samtidig sette A2 = filnavn og "lagre som" automatisk.

 

Skal loope til A2 er tom... A3, B3, C3 = B4, K8, L9.. osv

 

Eg skal få like mange filer som linjer i A med ulike filnavn

 

Treng litt hjelp med sjølve loopen og lagre automatisk. Forslag?

[Bigelk]

Hei.

 

Blir litt vanskelig og hjelpe deg med alt. Hvis det er mer du trenger hjelp til kan det være greit å stykke opp problemstillingen litt.

 

Her er en makro som oppretter ny arbeidsbok / arbeidsbøker. og lagrer den / de

Men det er det eneste den gjør. opretter og lagrer.

 

 

 
Option Explicit
Public sisteRad As Integer, ListeRange As Range, cel As Range, lagreHer As String, lagreSom As String, nyBok As Workbook
Sub Start_up()
'
' Ny_Bok Makro
'
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayStatusBar = False
    End With
    sisteRad = Sheets("Liste").Cells(Rows.Count, "A").End(xlUp).Row '//finner siste rad i kolonne A (Dynamisk)
   
    Set ListeRange = Sheets("Liste").Range("A1:A" & sisteRad & "") '//setter området som skal loopes igjennom
   
    lagreHer = "H:\Excel\Tek\pakbus\Bøker" & "\" '//hvor du skal lagre boken bytt ut "H:\Excel\Tek\pakbus\Bøker" med den mappen du vil lagre i
   
    For Each cel In ListeRange
   
        lagreSom = cel.Value ' //hva arbeidsboken skal lagres som
        Set nyBok = Workbooks.Add ' //åpner en ny arbeidsbok
        nyBok.SaveAs lagreHer & lagreSom, FileFormat:=xlWorkbook ' //hvor arbeidsboken lagres & hva den lagres som, hvilket format
        nyBok.Close ' //lukker den nye arbeidsboken
       
    Next cel
   
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayStatusBar = True
    End With
   
'
End Sub

 

Mvh

 

Torbjørn