选择activeworkbook的几行到一个新的工作簿？得到总花掉的钱

Question

我对VBA很陌生。我试图只选择一个新的工作簿(名字，年龄，花钱和日期)，但得到了错误信息与‘对象变量或块变量未设置’。

2)。也想得到总金额的花费。

Sub Table()

Dim wb As Workbook
Dim ws As Worksheet
Dim nwb as workbook
Dim nws as worksheet

Set wb = ThisWorkbook
Set ws = wb.workshets("Sheet1")

ws.copy
set nwb = ActiveWorkbook
Set nws = nwb.Worksheets("Sheet1").Range("B2").Value = nws.Range("B2").Value

With nws
.Cells().Copy
.Cells().PasteSpecial (xlPasteValues)
End With

End Sub

​

​

Answer 1

创建一个新表

• --这将在新的工作簿中创建工作表的副本，使用所需列列表删除不想要的列。

Option Explicit

Sub CreateNewTable()
    
    ' 1. Define constants
    
    Const sName As String = "Sheet1"
    Const HeaderRow As Long = 1
    ' Write the desired titles to a variant array ('Titles').
    Dim Titles() As Variant ' The order is not important!
    Titles = Array("Name", "Age", "Spent Money", "Date")
    
    ' 2. Copy the worksheet.
    
    ' Reference the source workbook ('swb')
    Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
    ' Reference the source worksheet ('sws').
    Dim sws As Worksheet: Set sws = swb.Worksheets(sName)
    
    ' Create a copy of the source worksheet in a new single-worksheet workbook.
    sws.Copy
    
    ' 3. Reference the destination objects.
    
    ' Reference this new workbook, the destination workbook ('dwb').
    Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count) ' the last
    ' Reference the destination worksheet ('dws').
    Dim dws As Worksheet: Set dws = dwb.Worksheets(1) ' the one and only
    ' Reference the destination header row range ('dhrg').
    Dim dhrg As Range: Set dhrg = dws.UsedRange.Rows(HeaderRow)
    
    ' 4. Write the indexes of the matches of the header row range values
    '    in the titles array values, to another array ('TitleIndexes').
    
    ' Since dhrg is a single-row range, the resulting array will be
    ' a 1D one-based array.
    Dim TitleIndexes() As Variant
    TitleIndexes = Application.Match(dhrg.Value, Titles, 0)
    
    ' 5. Combine the undesired cells in a range union,
    '    in the destination delete range.
    
    ' Declare additional variables.
    Dim ddrg As Range ' Destination Delete Range
    Dim ti As Long ' Current Index of TitleIndexes
    
    ' Loop through the elements of the title indexes array.
    For ti = 1 To UBound(TitleIndexes)
        If IsError(TitleIndexes(ti)) Then ' is not a match ('Error 2042')
            If ddrg Is Nothing Then ' first cell
                Set ddrg = dhrg.Cells(ti)
            Else ' all cells after the first
                Set ddrg = Union(ddrg, dhrg.Cells(ti))
            End If
        'Else ' is a match; do nothing
        End If
    Next ti
    
    ' 6. Delete the entire columns of the destination delete range.
    If Not ddrg Is Nothing Then ddrg.EntireColumn.Delete

    ' 7. Inform.
    MsgBox "New table created.", vbInformation

End Sub