Select the activeworkbook's a few rows to a new workbook? and get the total amount of spent mon-CodePudding

I'm very new to VBA. I'm trying to only select (Name, Age, Spent Money and Date) to a new workbook but got error message with 'Object variable or With block variable not set'.

2). Also want to get the total amount for the spent money.

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

CodePudding user response：

Create a New Table

This will create a copy of a worksheet in a new workbook, deleting the undesired columns using a list of desired columns.

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