Copying values to a separate Excel Sheet VBA

user_9029949 0
Viewed 75

I have code that auto-copies specific cells from a master sheet into another sheet. This is achieved when a specific value is entered into Column B.

For the example below, I want to copy all cells where the value in Column B is equal to Faults Raised. The issue I'm having is the master sheet has a separate script that hides/unhides columns based on other various 'values' entered into Column B.

When Faults Raised is entered, Columns B:C, AC:AE, BP are shown. But when I try to auto-copy across only Column B is shown. I can't get C, AC:AE and BP to copy across? What am I doing wrong?

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

copy vba excel sorting
1 Answers

Your .CurrentRegion is fouling up the area that you want to work within. Within sht1.Columns("B:BP").CurrentRegion either .Range("B:BP").EntireColumn is wrong addressing or .AutoFilter field:=1 is referring to column A. Intersect can help to overcome a couple of these problems.

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
Admin1
Related