Sub Macro1()
Dim column_index As Long, sh As Worksheet
Const destination_sheet = "copy"
  column_index = 1
  With ThisWorkbook
    For Each sh In .Sheets
      If sh.Name <> destination_sheet Then
        sh.Range("B7, B8").Copy Destination:=.Sheets(destination_sheet).Cells(1, column_index)
        column_index = column_index + 1
      End If
    Next sh
    .Sheets(destination_sheet).Activate
  End With
  Set sh = Nothing
End Sub