Excel to Access导入false列

我正在处理大量的历史数据，我制作了一个宏来将这些excel电子表格格式化为Access友好信息 . 但是，在将这些excel文件导入Access时遇到问题 . 无论我在VBA中编码什么，Access仍然认为在前四个实际数据之后大约有30个空白列 . 防止这种情况的唯一方法是手动进入并删除列 . 出于某种原因，我的VBA代码不会阻止它 . 我正在处理很多电子表格，因此手动删除这些列需要相当长的时间 . 我的代码如下;关于如何让Access正确解释这些的任何想法？

Public CU_Name As String
Sub RegulatorFormat()
    Dim wks As Worksheet
    Dim wks2 As Worksheet
    Dim iCol As Long
    Dim lastRow As Long
    Dim Desc As Range
    Dim lastCol As Long

    Application.ScreenUpdating = False
    Worksheets.Select
    Cells.Select
    Selection.ClearFormats
    Call FormulaBeGone
    ActiveSheet.Cells.Unmerge
    CU_Name = [B1].Value

    lastRow = Range("C" & Rows.Count).End(xlUp).Row
    Set Desc = Range("A1", "A57")
    Desc.Select

    For Each wks In ActiveWindow.SelectedSheets
        With wks
            On Error Resume Next
            For iCol = 16 To 4 Step -1
                Dim PerCol As Date
                    PerCol = Cells(1, iCol)
                    .Columns(iCol).Insert
                    Range(Cells(1, iCol), Cells(lastRow, iCol)) = CU_Name
                    .Columns(iCol).Insert
                    Range(Cells(1, iCol), Cells(lastRow, iCol)) = Desc.Value
                    .Columns(iCol).Insert
                    Cells(1, iCol).Value = PerCol
                    Range(Cells(1, iCol), Cells(lastRow, iCol)) = Cells(1, iCol)
                    Range(Cells(1, iCol), Cells(lastRow, iCol)).NumberFormat = "mm/dd/yyyy"
            Next iCol
        End With
    Next wks
    Rows("1:2").EntireRow.Delete
    Columns("A:C").EntireColumn.Delete
    lastCol = ws.Cells.Find(What:="*", _
                After:=ws.Cells(1, 1), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Column

    For Each wks2 In ActiveWindow.SelectedSheets
        With wks2
            On Error Resume Next
            For iCol = 52 To 6 Step -4
                lastRow = Range("C" & Rows.Count).End(xlUp).Row
                Set CutRange = Range(Cells(1, iCol), Cells(54, iCol - 3))
                CutRange.Select
                Selection.Cut
                Range("A" & lastRow + 1).Select
                ActiveSheet.Paste
            Next iCol
        End With
    Next wks2
Columns("E:ZZ").Select
Selection.EntireColumn.Delete
Application.ScreenUpdating = True
Rows("1").Insert
[A1] = "Period"
[B1] = "Line#"
[C1] = "CU_Name"
[D1] = "Balance"
Columns("E:BM").Select
Selection.Delete Shift:=xlToLeft
Call Save
End Sub

Sub FormulaBeGone()
    Worksheets.Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    ActiveSheet.Select
    Application.CutCopyMode = False
End Sub

Sub Save()
    Dim newFile As String

    newFile = CU_Name
        ChDir ("W:\ALM\Statistics\MO Automation\2015")
        'Save folder
        ActiveWorkbook.SaveAs Filename:=newFile

    'Later should seperate CU's into folder by province and year
End Sub