[Løst] Excel 2007 vba. lagre arbeidsark som ny arbeidsbok

[Bigelk]

Hei.

 

Jeg har lagd et salgskjema som jeg må lagre hver gang jeg er ferdig med et salg.

Jeg vil da at navnet på den nye arbeidsboken som lagres får navnene på produktene jeg selger.

Jeg kan selge inntil 10 produkter på en gang.

navnet på produktene står i celle :c2, j2, q2, x2, ae2, al2, as2, az2, bg2, bn2

Men det er ikke alltid at jeg selger så mange produkter på en gang.

Jeg har også en startdato og sluttdato i celle (startdato)a4 og (sluttdato)a6

 

Så hvis jeg har f.eks 3 produker eple, banan og sitron som jeg starta og selge 01.01.2012 og avslutta salget 03.01.2012

så vil den nye arbeidsboken hete eple.banan.sitron 01.01.2012 03.01.2012

 

Jeg trenger da også at den lagrer seg i en spesifikk mappe.

 

Jeg har en kode som jeg har prøvd men, men den fungerer ikke helt opptimalt

Dim wb As Workbook
Worksheets("ark1").Copy
Set wb = ActiveWorkbook
wb.SaveAs cells(1, 3)
wb.Close

 

Noen som har noen forslag på hvordan det kan løses?

 

Hilsen

 

Torbjørn

[Bigelk]

Hei.

 

Har kommet litt lengre, men i steden for at jeg får opp et vindu hvor jeg velger hvor den skal lagres

vil jeg bare at den lagres automatisk i L:\salg\Rapport

Men vet ikke hvordan jeg får det inn i den koden jeg har nå

 

Dim DstFile As String

   Dim c2 As String
   Dim j2 As String
   Dim q2 As String
   Dim x2 As String
   Dim ae2 As String
   Dim al2 As String
   Dim as2 As String
   Dim az2 As String
   Dim bg2 As String
   Dim bn2 As String

   c2 = Range("C2").Value
   j2 = Range("J2").Value
   q2 = Range("Q2").Value
   x2 = Range("X2").Value
   ae2 = Range("AE2").Value
   al2 = Range("AL2").Value
   as2 = Range("AS2").Value
   az2 = Range("AZ2").Value
   bg2 = Range("BG2").Value
   bn2 = Range("BN2").Value

   Dim FD As String 'Fra dato
   FD = Range("a4").Value

   Dim TD As String 'Til dato
   TD = Range("a6").Value


    'kopier ark og gi det nytt navn
   Application.ScreenUpdating = False
   Dim wb As Workbook
   Dim NewShtName As String
   NewShtName = "salg"

   Sheets("ark1").Copy
   Set wb = ActiveWorkbook
   wb.Sheets("ark1").Name = NewShtName

    'Prompt for SaveAs navn
   DstFile = Application.GetSaveAsFilename _
   (InitialFileName:=c2 & " " & j2 & " " & q2 & " " & x2 & " " & ae2 & " " & al2 & " " & as2 & " " & az2 & " " & bg2 & " " & bn2 & " " & FD & " to " & TD & ".xls", _
   Title:="Save As")
   If DstFile = "False" Then
       MsgBox "File not Saved, Actions Cancelled."
       Exit Sub
   Else
       wb.SaveAs DstFile 'Lagre
       wb.Close 'Lukk
   End If
   Application.ScreenUpdating = True

 

Hilsen

 

Torbjørn

[Bigelk]

Hei.

 

Har kommet litt lengre

 

Dim wbN As String

Dim Pn As String
   Pn = Range("C2").Value
Dim Pn2 As String
   Pn2 = Range("J2").Value
Dim Pn3 As String
   Pn3 = Range("Q2").Value
Dim Pn4 As String
   Pn4 = Range("X2").Value
Dim Pn5 As String
   Pn5 = Range("AE2").Value
Dim Pn6 As String
   Pn6 = Range("AL2").Value
Dim Pn7 As String
   Pn7 = Range("AS2").Value
Dim Pn8 As String
   Pn8 = Range("AZ2").Value
Dim Pn9 As String
   Pn9 = Range("BG2").Value
Dim Pn10 As String
   Pn10 = Range("BN2").Value
Dim FD As String 'Fra dato
   FD = Range("A4").Value
Dim TD As String 'Til dato
   TD = Range("A6").Value

'kopier ark og gi det nytt navn
Application.ScreenUpdating = False
Dim wb As Workbook
Dim NewShtName As String
    NewShtName = "salg"

Sheets("ark1").Copy
Set wb = ActiveWorkbook
wb.Sheets("ark1").Name = NewShtName

    'Navn på ny arbeidsbok
wbN = Pn & " " & Pn2 & " " & Pn3 & " " & Pn4 & " " & Pn5 & " " & Pn6 & " " & Pn7 & " " & Pn8 _
           & " " & Pn9 & " " & Pn10 & " " & FD & " til " & TD & ".xls"

wb.SaveAs wbN:= _
"\\filserver\tope\salg\filename"
wb.Close 'Lukk

Application.ScreenUpdating = True

 

Får opp feilkoden. Compile error named argument not found

 

Men hvis jeg fjerner:

:= _
"\\filserver\tope\salg\filename"

 

Da lagrer den fila med det navnet jeg vil, men da lagrer den seg jo ikke der jeg vil den skal lagre seg.

 

Forslag?

 

Hilsen

 

Torbjørn

Endret 31. januar 2012 av Bigelk

[Bigelk]

Hei.

 

Da var den løst.

 

Dim wbN As String
Dim filepath As String
Dim Pn As String
   Pn = Range("C2").Value
Dim Pn2 As String
   Pn2 = Range("J2").Value
Dim Pn3 As String
   Pn3 = Range("Q2").Value
Dim Pn4 As String
   Pn4 = Range("X2").Value
Dim Pn5 As String
   Pn5 = Range("AE2").Value
Dim Pn6 As String
   Pn6 = Range("AL2").Value
Dim Pn7 As String
   Pn7 = Range("AS2").Value
Dim Pn8 As String
   Pn8 = Range("AZ2").Value
Dim Pn9 As String
   Pn9 = Range("BG2").Value
Dim Pn10 As String
   Pn10 = Range("BN2").Value
Dim FD As String 'Fra dato
   FD = Range("A4").Value
Dim TD As String 'Til dato
   TD = Range("A6").Value

'kopier ark og gi det nytt navn
Application.ScreenUpdating = False
Dim wb As Workbook
Dim NewShtName As String
    NewShtName = "salg"

Sheets("ark1").Copy
Set wb = ActiveWorkbook
wb.Sheets("ark1").Name = NewShtName

    'Navn på my arbeidsbok
wbN = Pn & " " & Pn2 & " " & Pn3 & " " & Pn4 & " " & Pn5 & " " & Pn6 & " " & Pn7 & " " & Pn8 _
           & " " & Pn9 & " " & Pn10 & " " & FD & " til " & TD & ".xls"
filepath = "\\filserver\tope\salg\"
wb.SaveAs filepath & wbN
wb.Close 'Lukk

Application.ScreenUpdating = True

 

Hilsen

 

Torbjørn