vba - 保留几列并根据输入的数据保持休息

Question

嗨，我有一个 Excel 表，每个月有 5 个类似的列（一月、二月等）。

我有 VBA 代码，它会自动为下个月创建列（在这种情况下是 3 月）。输入 March 数据后，我希望我的文件保存为 March.xls，删除本月剩余时间的数据（同时保留原始文件中的所有月份数据）。有没有办法用 VBA 做到这一点？我将不胜感激您的回复相同。我希望我的每个月文件在下面“另存为”：

我在网上找到了下面的代码，它正在工作。唯一的问题是我必须在此代码中输入要删除的列的名称，例如：代码中的“April”。是否可以使此代码以自动保留最后四列和第一列（ID 列）并删除其余部分的方式工作。谢谢

Sub DeleteData()
    Dim ws As Worksheet
    Dim ColList As String, ColArray() As String
    Dim LastCol As Long, i As Long, k As Long, l As Long, m As Long, j As Long
    Dim boolFound As Boolean
    Dim delCols As Range, delCols1 As Range, delCols2 As Range, delCols3 As Range
    Application.ScreenUpdating = False
    Set ws = Sheets("Sheet1")
    ColList = "April"
    ColArray = Split(ColList, ",")
    LastCol = ws.Cells.Find(What:="*", After:=ws.Range("A1"), Lookat:=xlPart, _
    LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
    MatchCase:=False).Column
    For i = 8 To LastCol
    boolFound = False
    For j = LBound(ColArray) To UBound(ColArray)
    If UCase(Trim(ws.Cells(1, i).Value)) = UCase(Trim(ColArray(j))) Then
    boolFound = True
    Exit For
    End If
    Next
    If boolFound = False Then
    If delCols Is Nothing Then
    Set delCols = ws.Columns(i)
    Else
    Set delCols = Union(delCols, ws.Columns(i))
    End If
    End If
    Next i
    If Not delCols Is Nothing Then delCols.Delete

Answer 1

Sub Copyandsave()
    Dim i As Long
    Rows("1:2").Select 'based on which rows that the name of months are inside let's suppose it is in row 1 or 2
        For Each cell In Selection 'search through aforementioned rows  for march label you can change it for other months


    If InStr(cell.Text, January) Or InStr(cell.Text, February) Or InStr(cell.Text, March) _
    Or InStr(cell.Text, April) Or InStr(cell.Text, May) Or InStr(cell.Text, June) _
    Or InStr(cell.Text, July) Or InStr(cell.Text, August) Or InStr(cell.Text, September) _
    Or InStr(cell.Text, October) Or InStr(cell.Text, November) Or InStr(cell.Text, September) Then
              i = 1 + i
          cell.Select
          Columns(Selection.Column).Select 'gets column number of cell
          Selection.Cut

        Workbooks.Add
        ActiveWorkbook.ActiveSheet.Paste
                ActiveWorkbook.SaveAs Filename:=Workbooks(1).path & i & ".xls", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False 'saves the document with name

    End If
                 Workbooks(1).Activate

        Next

    End Sub