Conditionally copy content of adjacent cells to different worksheet

[MrTinkertrai]

Hello Excelexperts,

In my worksheet called "WEEKPLANNING" I have a range currently stretching from cell AF23 to AF34.
Each cell within that range is either filled with "TRUE" or "FALSE"
Whenever it's TRUE I would like to have the contents of the adjacent cell (e.g. AG23, AG24 etc) copied to another worksheet (Sheet1) starting from B1 downwards.
Preferably I would like to make my current range dynamic.

Is there someone who can help me with that ?

Many thanks in advance,

Mike

[Kenneth Hobs]

The two approaches would be by a macro or by a formula. Both methods have their trade-offs.

By dynamic, do you want each change to update the whole output or just to use the input from AF23 and down?

[MrTinkertrai]

Hello Kenneth,

Thanks for chiming in.

By dynamic I meant that currently my range starts at AF23 and ends at AF34, but in the future that last cell could expand to AF50 or even further.

[Kenneth Hobs]

Sub Main()  
  Dim r As Range, t As Range, a As Range
  
  Set t = Worksheets("Sheet1").[A1]
  With Worksheets("WEEKPLANNING")
    Set r = .Range("AF24", .Cells(Rows.Count, "AF").End(xlUp))
  End With
  
  r.AutoFilter 1, "=True"
  Set a = StripFirstRow(r).Columns(2).SpecialCells(xlCellTypeVisible)
  r.AutoFilter
  
  If a Is Nothing Then Exit Sub
  a.Copy t
  Application.CutCopyMode = False
End Sub


Function StripFirstRow(aRange As Range) As Range
  Dim i As Long, j As Long, r As Range, z As Long, idx As Long
  For i = 1 To aRange.Areas.Count
    For j = 1 To aRange.Areas(i).Rows.Count
      z = z + 1
      If z = 1 Then GoTo NextJ
      If r Is Nothing Then
        Set r = aRange.Areas(i).Rows(j)
        Else
        Set r = Union(r, aRange.Areas(i).Rows(j))
      End If
NextJ:
    Next j
  Next i
  Set StripFirstRow = r
End Function

[MrTinkertrai]

Thank you very much, Kenneth

It works beautifully !!

Much appreciated

[MrTinkertrai]

Sub Main()  
  Dim r As Range, t As Range, a As Range
  
  Set t = Worksheets("Sheet1").[A1]
  With Worksheets("WEEKPLANNING")
    Set r = .Range("AF24", .Cells(Rows.Count, "AF").End(xlUp))
  End With
  
  r.AutoFilter 1, "=True"
  Set a = StripFirstRow(r).Columns(2).SpecialCells(xlCellTypeVisible)
  r.AutoFilter
  
  If a Is Nothing Then Exit Sub
  a.Copy t
  Application.CutCopyMode = False
End Sub


Function StripFirstRow(aRange As Range) As Range
  Dim i As Long, j As Long, r As Range, z As Long, idx As Long
  For i = 1 To aRange.Areas.Count
    For j = 1 To aRange.Areas(i).Rows.Count
      z = z + 1
      If z = 1 Then GoTo NextJ
      If r Is Nothing Then
        Set r = aRange.Areas(i).Rows(j)
        Else
        Set r = Union(r, aRange.Areas(i).Rows(j))
      End If
NextJ:
    Next j
  Next i
  Set StripFirstRow = r
End Function

Like I mentioned before this piece of code from Kenneth works like a charm.
I had to make some changes to my file and the range I was talking about (AF23:AF34) are now filled with formulas instead of TRUE or FALSE.
I would like to have the contents of the adjacent cells copied and pasted as values.

I've been trying figuring out myself where to add some code or make some changes, but to no avail.
I hope Kenneth or someone else could chime in here.

Many thanks in advance,

Mike

[Kenneth Hobs]

'a.Copy t
a.Offset(,1).Copy t.offset(,1)