2016-06-21 83 views
1

如何從工作簿中複製整個工作表並將其作爲新工作簿保存到具有自定義文件名的特定目錄中(我試圖從工作表中的單元格中選擇文件名。片,我需要複製有幾個單元格合併太從現有工作表創建新工作簿

Sub CopyItOver() 
Dim fname As String 
Dim fpath As String 
Dim NewBook As Workbook 
Dim name as String 

fpath = "C:\Users\..\" 
fname = "List" & name & ".xlsm" 
name = Range("c3").Value 

Set NewBook = Workbooks.Add 

ActiveWorkbook.Sheets("Generator").Copy Before:=NewBook.Sheets(1) 

    If Dir(fpath & "\" & fname) <> "" Then 
    MsgBox "File " & fpath & "\" & fname & " already exists" 
     Else 
    NewBook.SaveAs FileName:=fpath & "\" & fname 
End If 

End Sub 

當我運行這個它,給我下標超出範圍的錯誤在這行

ActiveWorkbook.Sheets("Generator").Copy Before:=NewBook.Sheets(1) 
+0

在這種情況下,你的挑戰是確定什麼語句的一部分是給你的錯誤。它可以是'Activeworkbook.Sheets(「Generator」)'或者它可以是'NewBook.Sheets(1)'。當程序停止時,選擇調試VBA並在即時窗口中鍵入Debug.Print Activeworkbook.Sheets(「Generator」)。Name和Debug.Print NewBook.Sheets(1).Name'並查看內容你得到。很可能這些行爲中的一個會給你提供錯誤,並告訴你缺少什麼。 – PeterT

回答

1

建議你試試這樣說:。

看到
  • 檢查發電機進展
  • 之前存在如果使用.Copy然後在工作表將自動複製到一個新的工作簿(這樣你就不會需要添加一本新書第一)

代碼

Sub CopyItOver() 
Dim fname As String 
Dim fpath As String 
Dim name As String 
Dim ws As Worksheet 

fpath = "C:\Users\..\" 
fname = "List" & name & ".xlsm" 
name = Range("c3").Value 

On Error Resume Next 
Set ws = ThisWorkbook.Sheets("Generator") 
On Error GoTo 0 

If ws Is Nothing Then 
    MsgBox "sheet doesn't exist" 
    Exit Sub 
End If 

If Dir(fpath & "\" & fname) = vbNullString Then 
    ThisWorkbook.Sheets("Generator").Copy 
    ActiveWorkbook.SaveAs Filename:=fpath & "\" & fname 
Else 
    MsgBox "File " & fpath & "\" & fname & " already exists" 
End If 

End Sub 
+1

非常感謝!有效!這是超級節省時間.. – Swathi

相關問題