開いているブックとオープンした後、それが戻ってサブの先頭に戻り、

Question

Option Explicit 
Sub DleteColumns() 

Dim objWorkbook As Workbook 
Dim i As Integer 
Dim keepColumn As Boolean 
Dim currentColumn As Integer 
Dim columnHeading As String 
Dim ws As Worksheet 

'This is temporary for testing this one below 

    Application.DisplayAlerts = False 

    currentColumn = 1 
    'open the workbook with data 
    DoEvents 
    Set objWorkbook = Workbooks.Open(_ 
    "H:\C_Files\xls\a_C_Track_20171101.xls") 
    'Do a pause 
    Application.Wait (Now + TimeValue("0:00:10")) 
    ThisWorkbook.Activate 
    Set ws = ActiveSheet 
    'Stop 
    'read the data from the first columns 
    For i = 1 To 1 

    currentColumn = 1 
     While currentColumn <= ActiveSheet.UsedRange.Columns.Count 
      columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value 

     'CHECK WHETHER TO KEEP THE COLUMN 
      keepColumn = False 

      If columnHeading = "#reason" Then keepColumn = True 
      If columnHeading = "first_name" Then keepColumn = True 
      If columnHeading = "last_name" Then keepColumn = True 
      If columnHeading = "employer_name" Then keepColumn = True 
      If columnHeadimg = "city" Then keepColumn = True 
      If columnHeading = "state" Then keepColumn = True 
      If columnHeading = "date_of_birth" Then keepColumn = True 
      If columnHeading = "ssn" Then keepColumn = True 

      If keepColumn Then 
       currentColumn = currentColumn + 1 
      Else 
       ActiveSheet.Columns(currentColumn).Delete 
      End If 

      'LASTLY AN ESCAPE IN CASE THE SHEET HAS NO COLUMNS LEFT 
      If (ActiveSheet.UsedRange.Address = "$A$1") And 
       (ActiveSheet.Range("$A$1").text = "") Then Exit Sub 
     Wend 

      Next i 
    Stop 
    'ActiveWorkbook.Save 
    'objWorkbook.Close 
    ActiveWorkbook.Close SaveChanges:=True 
    End Sub 

Answer 1

私の知る限り、あなたの唯一の本当の問題は、現在アクティブなシートに変更を適用している、ThisWorkbook.Activate声明による、ということですマクロを含むブックにあります。その単一の行を削除するだけで、あなたが望むようにあなたのマクロはうまくいくでしょう。

ただし、定数参照先はActiveSheetです。次のコードは、それがあなたのwsオブジェクトを使用するように変更します。コードはActiveSheetに設定されていますが（特に私の意見ではまだよくありませんが、ActiveSheetはブックが最後に保存されたときにどちらのシートがアクティブになっているかのように）、私はコメントに2つの設定方法より適切かもしれません。

Option Explicit 
Sub DleteColumns() 

    Dim objWorkbook As Workbook 
    Dim i As Integer 
    Dim keepColumn As Boolean 
    Dim columnHeading As String 
    Dim ws As Worksheet 

    Application.DisplayAlerts = False 

    'open the workbook with data 
    Set objWorkbook = Workbooks.Open("H:\C_Files\xls\a_C_Track_20171101.xls") 

    Set ws = ActiveSheet 
    'Better than the above line would be something like 
    'Set ws = objWorkbook.Worksheets("Sheet_I_want_to_process") 
    'or maybe 
    'Set ws = objWorkbook.Worksheets(1) 

    With ws 
     'Loop through each column in the sheet, working from right to left 
     For i = .UsedRange.Columns(.UsedRange.Columns.Count).Column To 1 Step -1 
      columnHeading = .Cells(1, i).Value 

      'CHECK WHETHER TO KEEP THE COLUMN 
      keepColumn = False 

      If columnHeading = "#reason" Then keepColumn = True 
      If columnHeading = "first_name" Then keepColumn = True 
      If columnHeading = "last_name" Then keepColumn = True 
      If columnHeading = "employer_name" Then keepColumn = True 
      'Ensure you type your variable names correctly - "columnHeadimg" in your 
      'code would have stopped your program running 
      If columnHeading = "city" Then keepColumn = True 
      If columnHeading = "state" Then keepColumn = True 
      If columnHeading = "date_of_birth" Then keepColumn = True 
      If columnHeading = "ssn" Then keepColumn = True 

      If Not keepColumn Then 
       .Columns(i).Delete 
      End If 
     Next 

     'Only save if there is something left 
     If .UsedRange.Address <> "$A$1" Or .Range("$A$1").Text <> "" Then 
      objWorkbook.Close SaveChanges:=True 
     End If 
    End With 
    Application.DisplayAlerts = False 
End Sub