my code is long and would like to know if it can be done better

Question

I've written the following code and would ask you experts if there is an way to write it better.

in a nutshell it clears the datatable and keep the formulas,

then it imports data from another sheet and saves it asa new file. then changes columns to value and dates.

after that it copies an column to the last column and separates it and shows online the first few characters.

at last I make a new sheet within were some filtering is done.

in short the code is working but I believe it can be done better and quicker.

Sub Openstaande_inslagen()

Application.ScreenUpdating = False
Call deletekeepformulas
Call COMMISSIE_EXTRAHEREN
Call PivotC

    ActiveWorkbook.RefreshAll
End Sub


' ----------------------------------------------------------------
' Purpose: Delete table data and keep table formulas
' ----------------------------------------------------------------
Sub deletekeepformulas()

    Dim tbl As ListObject

    'Assign table to a variable
    Set tbl = ThisWorkbook.Sheets("Inslagen").ListObjects("Tabel1")

    'Delete table data and keep formulas
    If Not tbl.DataBodyRange Is Nothing Then
        tbl.DataBodyRange.Delete
    End If
    Call wb
    Call AllWorksheetPivots
    Call Save_Workbook_NewName
    Call Convert_getal
    Call Convert_getal2
    
End Sub
Sub wb()

Code:
    Dim WB1 As Workbook
    Dim WB2 As Workbook
    
'   Capture current workbook
    Set WB1 = ActiveWorkbook
    
'   Open new workbook
    Call OpenNewBox
    
'   Capture new workbook
    Set WB2 = ActiveWorkbook
    ActiveSheet.UsedRange.Copy

'   Go back to original workbook
    WB1.Activate
   Sheets("Inslagen").Cells(1, 1).PasteSpecial Paste:=xlPasteValues
 
             
End Sub

Sub OpenNewBox()

Dim xFilePath As String
Dim xObjFD As FileDialog
Set xObjFD = Application.FileDialog(msoFileDialogFilePicker)
  With xObjFD
        .AllowMultiSelect = False
        .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm; *.xlsb", 1
        .Show
        If .SelectedItems.Count > 0 Then
            xFilePath = .SelectedItems.Item(1)
        Else
            Exit Sub
        End If
    End With
    
    Workbooks.Open xFilePath
End Sub
Sub AllWorksheetPivots()

'Updateby20140724
Dim xTable As PivotTable
For Each xTable In Application.ActiveSheet.PivotTables
    xTable.RefreshTable
Next

End Sub

Sub Save_Workbook_NewName()
Dim workbook_Name As Variant
workbook_Name = Application.GetSaveAsFilename(FileFilter:="Excel Macro-Enabled Workbook (*.xlsm),*.xlsm")
If workbook_Name <> False Then
    ActiveWorkbook.SaveAs Filename:=workbook_Name
End If

End Sub

Sub COMMISSIE_EXTRAHEREN()
'
' COMMISSIE_EXTRAHEREN Macro
' artikelnummer laten splitsen om zo alleen het commissienummer over te houden
'

'
Sheets("inslagen").Activate
ActiveSheet.ListObjects("Tabel1").ListColumns(15).DataBodyRange.Select
Selection.Copy
ActiveSheet.ListObjects("Tabel1").ListColumns(19).DataBodyRange.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
    Range("S1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Commissie"
    Range("S2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("S2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=":", FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
Call MultipleRange_DATE
Call MultipleRange_NUMBER
        
End Sub

Sub Convert_getal()
    Columns("A:A").Select
    With Selection
        .NumberFormat = "dd-mm-yyyy"
        .Value = .Value
End With
End Sub


Sub Convert_getal2()
    Columns("E:F").Select
    With Selection
        .NumberFormat = "General"
        .Value = .Value
End With
End Sub

Sub MultipleRange_DATE()
 Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range, myMultipleRange As Range
 Set r1 = Sheets("Inslagen").Range("G:G")
 Set r2 = Sheets("Inslagen").Range("H:H")
 Set r3 = Sheets("Inslagen").Range("K:K")
 Set r4 = Sheets("Inslagen").Range("L:L")
 Set r5 = Sheets("Inslagen").Range("T:T")
 Set myMultipleRange = Union(r1, r2, r3, r4, r5)
 myMultipleRange.NumberFormat = "dd-mm-yyyy"
End Sub
Sub MultipleRange_NUMBER()
 Dim r1 As Range, r2 As Range, myMultipleRange As Range
 Set r1 = Sheets("Inslagen").Range("A:A")
 Set r2 = Sheets("Inslagen").Range("E:F")
 Set myMultipleRange = Union(r1, r2)
 myMultipleRange.NumberFormat = "General"
End Sub

Sub PivotC()

    Sheets("nog afronden").Select
        Columns("A:A").Select
    With Selection
        .NumberFormat = "dd-mm-yyyy"
        .Value = .Value
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Select
    ActiveSheet.Name = "Bijna_afgerond"
Sheets("nog afronden").PivotTables("Draaitabel2").TableRange1.Copy Destination:=Worksheets("Bijna_afgerond").Range("A1")
Call DeleteEntireRows
Sheets("Bijna_afgerond").Activate

' SPATIES Macro
    Rows("1:1").Select
    Selection.Replace What:=" ", Replacement:="_", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
End With

Call DelLR2
Call ADD_COLUMN_TO_TABLE
Call Convert_getal3
Call DetermineActiveTable
Call Calculate_AF


End Sub
Sub DeleteEntireRows()
Sheets("Bijna_afgerond").Activate
Rows("1:2").EntireRow.Delete
Call Generate_Table
End Sub

Sub Generate_Table()
    Dim tb2 As Range
    Dim wsht As Worksheet
    Set tb2 = Range("A1").CurrentRegion
    Set wsht = ActiveSheet
    wsht.ListObjects.Add(SourceType:=xlSrcRange, Source:=tb2).Name = "TEST_RANGE"
End Sub

Sub DelLR2()

Dim x As Long

With Sheets("Bijna_afgerond")
'Assumes last row of data found in column A (1)
  x = .Cells(.Rows.Count, 1).End(xlUp).Row
  .Cells(x, 2).EntireRow.Delete
End With
Worksheets("Bijna_afgerond").Cells.EntireColumn.AutoFit
End Sub



Sub DetermineActiveTable()

Dim SelectedCell As Range
Dim TableName As String
Dim ActiveTable As ListObject

Set SelectedCell = ActiveCell

'Determine if ActiveCell is inside a Table
  On Error GoTo NoTableSelected
    TableName = SelectedCell.ListObject.Name
    Set ActiveTable = ActiveSheet.ListObjects(TableName)
  On Error GoTo 0

'Do something with your table variable (ie Add a row to the bottom of the ActiveTable)
  ActiveTable.Range.AutoFilter field:=6, Criteria1:="<>"
  
Exit Sub

'Error Handling
NoTableSelected:
  MsgBox "There is no Table currently selected!", vbCritical

End Sub

Sub Convert_getal3()
Dim myRange As Range
Set myRange = Selection
ActiveSheet.ListObjects("TEST_RANGE").ListColumns("Referentie").Range.Select
    With Selection
        .NumberFormat = "general"
        .Value = .Value
End With
End Sub

Sub Bijna_afgerond()
'
' BIJNA_AFGEROND Macro
' kijken naar een lijst met Bijna_afgeronde inslagen
'

'
    Sheets("nog afronden").Select
    ActiveSheet.PivotTables("Draaitabel2").RepeatAllLabels xlRepeatLabels
    
    Range("A7").Select
    Range("A7:F94").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("nog afronden").Select
    Sheets.Add After:=ActiveSheet
    Sheets("Blad2").Select
    Sheets("Blad2").Name = "Bijna_afgerond"
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.AutoFilter
    Cells.Select
    Cells.EntireColumn.AutoFit
    ActiveSheet.Range("$A$2:$F$89").AutoFilter field:=6, Criteria1:="<>"
    Range("G3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
    Range("G3").Select
    Selection.FillDown
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
    Sheets("nog afronden").Select
    ActiveSheet.PivotTables("Draaitabel2").RepeatAllLabels xlRepeatLabels
    End Sub
    
    Sub ADD_COLUMN_TO_TABLE()
    Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("TEST_RANGE")
'add a new column at the end of the table
tbl.ListColumns.Add.Name = "Percentage_voltooid"
ActiveSheet.Columns("A:G").AutoFit


    End Sub
    
Sub Calculate_AF()
Dim tbl As ListObject
Dim sFormula As String

    Set tbl = Sheets("Bijna_afgerond").ListObjects("TEST_RANGE")

    sFormula = "=[@[Som_van_Aantal_verwacht]]-[@[Som_van_Aantal_ontvangen2]]"
    

    tbl.ListColumns("Percentage_voltooid").DataBodyRange.Cells(1).Formula = sFormula
  
    tbl.ListColumns("Percentage_voltooid").DataBodyRange.Cells().Select
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
  

End Sub

Sub VOORWAARDELIJKE_OPMAAK()
'
' VOORWAARDELIJKE_OPMAAK Macro
'

'
    Range("G45").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
End Sub