Add data from one table to sheet as value

[Alex Bruski]

Have a problem with my Excel table. I have a smart table on sheet "Order calculation" and I would like to move this data to sheet "Sales History"

File here

code below:

Option Explicit

Sub UpdateLogWorksheet()

    Dim historyWks As Worksheet
    Dim inputWks As Worksheet

    Dim nextRow As Long
    Dim oCol As Long

    Dim myRng As Range
    Dim myCopy As String
    Dim myCell As Range
    
    'cells to copy from Input sheet - some contain formulas
     myCopy = ActiveSheet.ListObjects("Table1").DataBodyRange.Select

    Set inputWks = Worksheets("Order calculation")
    Set historyWks = Worksheets("Sales History")

    With historyWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With

   

    With historyWks
        With .Cells(nextRow, "A")
            .Value = Now
            .NumberFormat = "mm/dd/yyyy hh:mm:ss"
        End With
        
        
        With inputWks
        Set myRng = .Range(myCopy)

        If Application.CountA(myRng) <> myRng.Cells.Count Then
            MsgBox "Please fill in all the cells!"
          
            Exit Sub
        End If
    End With
    
    
    
        .Cells(nextRow, "B").Value = Application.UserName
        oCol = 3
        For Each myCell In myRng.Cells
            historyWks.Cells(nextRow, oCol).Value = myCell.Value
            oCol = oCol + 1
        Next myCell
    End With
    
    'clear input cells that contain constants
    With inputWks
      On Error Resume Next
         With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
              .ClearContents
              Application.GoTo .Cells(1) ', Scroll:=True
            
         End With
      On Error GoTo 0
    End With
End Sub

 

[Alex Blakenburg]

Lets start with this and go from there:

Sub UpdateLogWorksheet_mod()

    Dim historyWks As Worksheet
    Dim inputWks As Worksheet

    Dim nextRow As Long
    Dim oCol As Long

    Dim myRng As Range
    'Dim myCopy As String        ' XXX Removed not required
    'Dim myCell As Range         ' XXX Removed not required
    
        ' Changed from myCopy

    Set inputWks = Worksheets("Order calculation")
    'cells to copy from Input sheet - some contain formulas
    Set myRng = inputWks.ListObjects("Table1").DataBodyRange
    Set historyWks = Worksheets("Sales History")

    With historyWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With

    With historyWks.Cells(nextRow, "A")
        .Value = Now
        .NumberFormat = "mm/dd/yyyy hh:mm:ss"
    End With
                
    With inputWks
        If Application.CountA(myRng) <> myRng.Cells.Count Then
            MsgBox "Please fill in all the cells!"
          
            Exit Sub
        End If
    End With
    
    With historyWks
        .Cells(nextRow, "B").Value = Application.UserName
        myRng.Copy
        oCol = 3
        .Cells(nextRow, oCol).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    End With
    
    'clear input cells that contain constants
      On Error Resume Next
         With myRng.Cells.SpecialCells(xlCellTypeConstants)
              .ClearContents
              Application.GoTo .Cells(1) ', Scroll:=True
         End With
      On Error GoTo 0

End Sub