Re arrange columns from selected rows

[steveed]

All,
I am attaching an excel file. It also contains the macro needed for "Click Here" button

Sub Possible_Answer()
Dim i As Long
Dim copyRows As Range

With Sheets("Sample Problem")

For i = 7 To 13
If .Range("C" & i).Value = "Jane Fake" Then
If copyRows Is Nothing Then
Set copyRows = .Rows(i)
Else
Set copyRows = Union(copyRows, .Rows(i))
End If
End If
Next

If Not copyRows Is Nothing Then
copyRows.Copy Sheets("Sample Problem").Rows(18)
End If
End With
End Sub


But I need to re-arrange few columns to fit the target table.

Any help would be appreciated

Thanks in advance
Steve

[Bob Phillips]

Sub Possible_Answer()
Dim ary As Variant
Dim sRows As String
Dim nextrow As Long
Dim i As Long

With Sheets("Sample Problem")

ary = Application.Transpose(.Evaluate("IF(C6:C12=""Jane Fake"",ROW(C6:C12))"))
sRows = Replace(Replace(Join(ary, ","), "False,", ""), "False", "")
ary = Split(sRows, ",")

nextrow = 17
For i = LBound(ary) To UBound(ary)

.Cells(ary(i), "B").Copy .Cells(nextrow, "D")
.Cells(ary(i), "C").Resize(, 2).Copy .Cells(nextrow, "B")
.Cells(ary(i), "E").Copy .Cells(nextrow, "F")
.Cells(ary(i), "F").Copy .Cells(nextrow, "E")
nextrow = nextrow + 1
Next i
End With
End Sub

[p45cal]

or:Sub blah()
Dim i As Long
Range("C5").AutoFilter Field:=2, Criteria1:="Jane Fake"
With ActiveSheet.AutoFilter.Range
For i = 1 To .Columns.Count
.Columns(i).Offset(1).Resize(.Rows.Count - 1).Copy Cells(17, Choose(i, "d", "b", "c", "f", "e"))
Next i
.AutoFilter
End With
End Sub

[steveed]

Sub Possible_Answer()
Dim ary As Variant
Dim sRows As String
Dim nextrow As Long
Dim i As Long

With Sheets("Sample Problem")

ary = Application.Transpose(.Evaluate("IF(C6:C12=""Jane Fake"",ROW(C6:C12))"))
sRows = Replace(Replace(Join(ary, ","), "False,", ""), "False", "")
ary = Split(sRows, ",")

nextrow = 17
For i = LBound(ary) To UBound(ary)

.Cells(ary(i), "B").Copy .Cells(nextrow, "D")
.Cells(ary(i), "C").Resize(, 2).Copy .Cells(nextrow, "B")
.Cells(ary(i), "E").Copy .Cells(nextrow, "F")
.Cells(ary(i), "F").Copy .Cells(nextrow, "E")
nextrow = nextrow + 1
Next i
End With
End Sub


That did it, thank you very much