vb kode til at gemme et ark

Public Sub wbNyProjektmappe()
Dim wbNyProjektmappe As Workbook

Set wbNyProjektmappe = Workbooks.Add
wbNyProjektmappe.Worksheets("Ark1").Range("A1").Value = 100
wbNyProjektmappe.SaveAs "Din fil navn"
wbNyProjektmappe.Close
MsgBox "Projektmappe er lukket."

End Sub

mvh

mvhansen

vil det så sige at i "Din fil navn" ="ark1;A1" F.eks!?

Public Sub wbNyProjektmappe()
Dim wbNyProjektmappe As Workbook
Set wbNyProjektmappe = Workbooks.Add
wbNyProjektmappe.SaveAs "Din fil navn"      >her skal du skrive navnet på din fil<
wbNyProjektmappe.Close
MsgBox "Projektmappe er lukket."

End Sub


MVH

MVHANSEN

den laver et nyt ark og skriver 100 i a1

hvis vi siger det er ark3 som skal gemmes i en ny mappe i G:/doks/test/
Og fil navnet finder den på ark2 i "C1"

Ok den gemmer hele projegt mappen
jeg er ikke så stærk til vba men jeg prøver lig at kigge på det

mvh

mvhansen

Skal ark3 gemmes i en anden projegt mappen hvor der er andre ark

mvh

mvhansen

jah den skal gøre som hvis man kopier det ark til en ny mappe. så det kun er det ark det kommer i den nye mappe som ark1 gør ike noget hvis den kopier det over i en ny mappe i ark 1 og så gemmer det bare det kommer i ark1

Hej splokit
jeg har fundet noget prøv at kigge
http://www.eksperten.dk/spm/158576


Sub kopieralledata()
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = \"Nyt\"
For Each sh In ThisWorkbook.Worksheets
    If sh.Name = \"Nyt\" Then GoTo springover
    sh.Select
    Set rngA = Range(\"A1\", Range(\"A65536\").End(xlUp).Offset(1, 6))
    rngA.Select
    JaNej = MsgBox(\"Skal dette kopiers over ??\", vbYesNo)
    If JaNej = vbNo Then GoTo springover
    rngA.Copy
    Worksheets(\"Nyt\").Activate
    Range(\"A65536\").End(xlUp).Offset(2, 0).Select
    ActiveSheet.Paste
springover:
Next
End Sub

mvh

mvhansen

humm ikke lige noget jeg kan få til at virke....

Hvad med denne her den laver kun en lille fejl men kan ikke fikse den selv... :S
Sub LagreSomTekstfil()
 
  Dim fso As FileSystemObject
  Dim fsoFld As folder
  Dim fsoFil As File
 
  Dim filnavn As String
  Dim rngCopyRange As Range
  Dim n As Variant
  Dim s As String
  s = ""
  Set rngCopyRange = ThisWorkbook.Sheets("Ark2").Range("A1:Z200")
  filnavn = "" & ThisWorkbook.Sheets("Ark3").Cells(2, 2).Value & ".xls"
 
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set fsoFld = fso.GetFolder("C:\test\")
 
  If fso.FileExists(fsoFld & "\" & filnavn) Then
    n = 1
    Do While fso.FileExists(fsoFld & "\" & Left( _
      filnavn, Len(filnavn) - 4) & " " & n & ".xls")
      n = n + 1
    Loop
    s = ""
  End If
  filnavn = Left(filnavn, Len(filnavn) - 4) & s & n & ".xls"
 
  With Workbooks.Add
    With Sheets("Ark1")
      .Range("A1:Z200").Value = rngCopyRange.Value
      ActiveWorkbook.SaveAs Filename:=fsoFld & "\" & filnavn, FileFormat:=xlText
    End With
    Application.DisplayAlerts = False
    .Close
    Application.DisplayAlerts = True
  End With
 
  Set fso = Nothing
  Set fsoFld = Nothing
End Sub

Vær lige opmærksom på at når man kigger på så gamle spørgsmål skal man fjerne alle de \ der findes før apostrofferne

Sådan mener du!?
Sub kopieralledata()
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Nyt\"
For Each sh In ThisWorkbook.Worksheets
    If sh.Name = "Nyt\" Then GoTo springover
    sh.Select
    Set rngA = Range("A1\", Range(\"A65536\").End(xlUp).Offset(1, 6))
    rngA.Select
    JaNej = MsgBox("Skal dette kopiers over ??\", vbYesNo)
    If JaNej = vbNo Then GoTo springover
    rngA.Copy
    Worksheets("Nyt\").Activate
    Range("A65536\").End(xlUp).Offset(2, 0).Select
    ActiveSheet.Paste
springover:
Next
End Sub

mvh

Hej  splokit


Sub kopieralledata()
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Nyt"
For Each sh In ThisWorkbook.Worksheets
    If sh.Name = "Nyt" Then GoTo springover
    sh.Select
    Set rngA = Range("A1", Range("A65536").End(xlUp).Offset(1, 6))
    rngA.Select
    JaNej = MsgBox("Skal dette kopiers over ??", vbYesNo)
    If JaNej = vbNo Then GoTo springover
    rngA.Copy
    Worksheets("Nyt").Activate
    Range("A65536").End(xlUp).Offset(2, 0).Select
    ActiveSheet.Paste
springover:
Next
End Sub

alle \ skal fjernes
mvh

mvhansen

Arr oki så er jeg med... prøver lige.. :S

nej den virker ikke... den laver fejl 400 ikke andet og laver et nyt ark

humm