シート内の文字列に基づいて列を削除したい

Question

このコードを作成しましたが、定義されたヘッダーを含むシートをループして感謝の男を削除することはできません。

Sub deleteCol() 

On Error Resume Next 
Dim Coldellr As Long 
Dim colval As String 
Dim wbCurrent As Workbook 
Dim wsCurrent As Worksheet 
Dim nLastCol, i As Integer 
Dim LngLp As Long 

Coldellr = Sheets("Coldel").Cells(Rows.Count, "A").End(xlUp).row 'Define LastRow 

Set wbCurrent = ActiveWorkbook 
Set wsCurrent = wbCurrent.ActiveSheet 
'This next variable will get the column number of the very last column that has data in it, so we can use it in a loop later 
nLastCol = wsCurrent.Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 

'This loop will go through each column header and delete the column if the header contains "Percent Margin of Error" 
For i = nLastCol To 1 Step -1 
    For LngLp = 1 To Coldellr 
    Set colval = Sheets("Coldel").Range("a" & LngLp).Value 

    If InStr(1, wsCurrent.Cells(1, i).Value, colval, vbTextCompare) > 0 Then 
     wsCurrent.Columns(i).Delete Shift:=xlShiftToLeft 
    End If 
Next i 

End Sub 

Answer 1

は、シートごとにループを追加するコードを使用しました。うまくいくはずです。

Sub deleteCol() 

    On Error Resume Next 
    Dim Coldellr As Long 
    Dim colval As String 
    Dim wbCurrent As Workbook 
    Dim wsCurrent As Worksheet 
    Dim nLastCol, i As Integer 
    Dim LngLp As Long 

    Coldellr = Sheets("Coldel").Cells(Rows.Count, "A").End(xlUp).Row 'Define LastRow 

    Set wbCurrent = ActiveWorkbook 

    Dim sh As Worksheet '@nightcrawler23 

    For Each sh In wbCurrent.Sheets '@nightcrawler23 

     Set wsCurrent = sh '@nightcrawler23 

     'This next variable will get the column number of the very last column that has data in it, so we can use it in a loop later 
     nLastCol = wsCurrent.Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 

     'This loop will go through each column header and delete the column if the header contains "Percent Margin of Error" 
     For i = nLastCol To 1 Step -1 
      For LngLp = 1 To Coldellr 

      ' Edit: 
      ' removed Set here as a value is being assigned 
      colval = Sheets("Coldel").Range("a" & LngLp).Value 

      If InStr(1, wsCurrent.Cells(1, i).Value, colval, vbTextCompare) > 0 Then 
       wsCurrent.Columns(i).Delete Shift:=xlShiftToLeft 
      End If 
     Next i 

    Next sh '@nightcrawler23 



End Sub