保留幾欄，並根據輸入的數據保持休息

Question

嗨我有一個Excel表格，每月有5個類似的列（1月，1月等）。

我有VBA代碼，將自動使列下一個下一個月（在這種情況下，這將是3月）。輸入行軍數據後，我想將我的文件保存爲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