Копирование значений в отдельный лист Excel VBA

Question

У меня есть code, который автоматически копирует определенные cells с мастера sheet в другой sheet.Это достигается, когда в Column B вводится конкретный value.

Для приведенного ниже примера я хочу скопировать все cells, где value в Column B равно Faults Raised.У меня проблема в том, что у мастера sheet есть отдельный script, который скрывает / показывает columns на основе других различных 'values', введенных в Column B.

Когда введено Faults Raised, Columns B:C, AC:AE, BP показаны.Но когда я пытаюсь выполнить автоматическое копирование, отображается только Column B.Я не могу получить C, AC:AE и BP для копирования?Что я делаю не так?

Option Explicit

Sub FilterAndCopy()
  Dim sht1 As Worksheet, sht2 As Worksheet

  Set sht1 = Sheets("SHIFT LOG")
  Set sht2 = Sheets("FAULTS RAISED")

  sht2.UsedRange.ClearContents
  Dim rng As Range

  With sht1.Cells(2, "B").CurrentRegion
      .Range("B:BP").EntireColumn.Hidden = False ' unhide columns
      .AutoFilter
      .AutoFilter 2, "Faults Raised"
      .SpecialCells(xlCellTypeVisible).Copy sht2.Cells(6, 2)
      .AutoFilter

      .Range("C:AA").EntireColumn.Hidden = True ' hide columns
      sht2.Range("C:AA").EntireColumn.Delete ' delete 'sht2' columns
      .Range("AE:BN").EntireColumn.Hidden = True ' hide columns
      sht2.Range("AE:BN").EntireColumn.Delete ' delete 'sht2' columns
  End With

End Sub

Answer 1

Ваш .CurrentRegion заполняет область, в которой вы хотите работать.Внутри sht1.Columns ("B: BP"). CurrentRegion либо .Range ("B: BP"). Целостный столбец имеет неправильную адресацию, либо поле .AutoFilter: = 1 относится к столбцу A. Пересечение может помочь преодолеть пару из них.проблемы.

Option Explicit

Sub FilterAndCopy()
    Dim rng As Range, sht1 As Worksheet, sht2 As Worksheet

    Set sht1 = Worksheets("SHIFT LOG")
    Set sht2 = Worksheets("FAULTS RAISED")

    sht2.UsedRange.ClearContents

    With Intersect(sht1.Columns("B:BP"), sht1.UsedRange)
        .Cells.EntireColumn.Hidden = False ' unhide columns
        If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
        'within B:BP, column B is the first column
        .AutoFilter field:=1, Criteria1:="Faults Raised"
        'within B:BP, Columns B:C, AC:AE, BP are referenced as .Columns A:B, AB:AD, BO
        .Range("A:B, AB:AD, BO:BO").Copy Destination:=sht2.Cells(6, "B")
        .Parent.AutoFilterMode = False

        'no need to delete what was never there
        'within B:BP, Columns C:AA, AE:BN, BP are referenced as .Columns B:Z, AD:BM
        .Range("B:Z").EntireColumn.Hidden = True ' hide columns
        .Range("AD:BM").EntireColumn.Hidden = True ' hide columns
    End With
End Sub