從Excel以一定的信息，並在新工作簿

Question

我需要幫助

我從一個工作簿試圖額外的信息，並將其保存在一個新的單節省，但我需要單獨它取決於它參考具有。

我使用了下面的代碼，它非常棒，但它的表單不是新的。

與VB-不是很好，因爲我以前用過這個。

Option Explicit 

Sub Main() 

    Application.ScreenUpdating = False 
    Dim rangeToSearch As Range 
    Set rangeToSearch = Sheets(1).Range("C2:C" & Sheets(1).Range("C" & Rows.Count).End(xlUp).Row) 

    Dim searchAmount As String 
    searchAmount = InputBox("reference:") 

    Dim cell As Range 
    For Each cell In rangeToSearch 
     If cell = CLng(searchAmount) Then 
      Sheets(1).Rows(cell.Row & ":" & cell.Row).Copy 
      Sheets(2).Rows(_ 
      Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1 & _ 
      ":" & _ 
      Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1 _ 
      ).PasteSpecial _ 
     Paste:=xlPasteValues, Operation:=xlNone, _ 
     SkipBlanks:=False, Transpose:=False 
    Application.CutCopyMode = False 
     End If 
    Next 
Application.ScreenUpdating = True 
End Sub 

這一直很好迄今我只是不知道如何將其更改爲新的工作簿，而不是工作表。

請幫助

感謝

Answer 1

解決方案＃1：保存該紙張，作爲一個新的工作簿

的For-Loop後，添加以下內容：

Sheets(2).Copy 
Set wb2 = Workbooks(Workbooks.Count) 
wb2.SaveAs "C:\Users\YourUser\Documentstest.xls"l 

而且因爲你使用Option Explicit ，您需要在功能頂部添加dim wb2 as Workbook

---

解決方案2：創建一個新的工作簿

Option Explicit 

Sub Main() 

    Application.ScreenUpdating = False 

    Dim wb1 As Workbook 
    Dim ws1 As Worksheet 
    Set wb1 = ThisWorkbook 
    Set ws1 = wb1.Worksheets(1) 

    Dim wb2 As Workbook 
    Dim ws2 As Worksheet 
    Set wb2 = Workbooks.Add 
    Set ws2 = wb2.Worksheets(1) 

    Dim rangeToSearch As Range 
    Set rangeToSearch = ws1.Range("C2:C" & ws1.Range("C" & Rows.Count).End(xlUp).Row) 

    Dim searchAmount As String 
    searchAmount = InputBox("reference:") 

    Dim cell As Range 
    For Each cell In rangeToSearch 
     If cell = CLng(searchAmount) Then 
      ws1.Rows(cell.Row).Copy 
      ws2.Rows(ws2.Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial _ 
       Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False 

      Application.CutCopyMode = False 
     End If 
    Next 
Application.ScreenUpdating = True 
End Sub