入力したデータに基づいてカラム数を少なくしてください。

Question

こんにちは、毎月5つの類似したカラム（jan、Febなど）を持つExcelシートがあります。

私は、自動的に（行進となり、この場合には）次の翌月の列を行いますVBAコードを持っています。 marchデータを入力した後、月の残りのデータを削除するMarch.xlsとしてファイルを保存したい（元のファイルのすべての月のデータを保持する）。 VBAでそれを行う方法はありますか？私はあなたの反応を同じように試薬に感謝します。私は毎月のファイルを以下のように「保存」することを希望します：

私は以下のコードをオンラインで見つけ出しています。唯一の問題は、このコードで削除したい列の名前を入力する必要があることです。たとえば、コード内に「April」と入力します。最後の4つの列と最初の列（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