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

从excel获取某些信息并保存在新工作簿中

1 个答案: