Excel: импорт данных ячейки на другой лист с использованием заголовка столбца

Question

Я пытаюсь перенести информацию с одного листа на другой в той же книге.

Тем не менее, я хотел бы, чтобы положительные ячейки были импортированы в последовательные листы с именем их столбца.

Например:

           |  Example1 | Example2 | Example3
-----------+-----------+----------+----------
List One   |     x     |          |   x
List Two   |     x     |    x     |
List Three |     x     |          |

Так что я хотел бы

• в листе 2 - список первый

  • Example1
  • Example3

• В листе 3 - список два

  • Example1
  • Example2

• В листе 4 - третий список

  • Example1

Надеюсь, что это имеет какой-то смысл для кого-то! Извините за ужасное кодирование, ржавый ржавый ржавый!

Answer 1

Я предполагаю, что ваши заголовки находятся в строке 1, а данные начинаются со строки 2

В 1-м столбце (строка здесь не имеет значения) других ваших листов введите эту формулу =OFFSET(Sheet1!$A$1,0,SMALL(IF(2:2="X",COLUMN(2:2)),COLUMN())-1) в виде формулы массива с помощью Ctrl+Shift+Enter

скопируйте это через строку, и это перечислит имена столбца. Конец достигается, когда формула начинает давать #NUM! ошибки.

Для листа 3 измените с 2:2 на 3:3 и т.д. Для последующих листов

Answer 2

Это позволяет вам иметь большее количество строк и столбцов и предполагает что угодно, а не просто "x". Вы можете быть уверены, что это всегда "x", и изменить это довольно легко. Также я сделал эти именные листы согласно их названию списка. Если добавление листов не произойдет, вы можете удалить эту часть.

Sub columnsToListSheets()
LastCol = Sheets("Sheet1").UsedRange.Columns.Count
For rowNumber = 2 To 4
i = 1
    ListName = Sheets("Sheet1").Cells(rowNumber, 1)
    Sheets.Add
     NewSheet = ActiveSheet.Name
      Worksheets(NewSheet).Cells(1, 1) = ListName
      'You may want to name the worksheet after the list
      Worksheets(NewSheet).Name = ListName

For colNumber = 2 To LastCol
                                                        '"x" may be good enough to test for
    If Worksheets("Sheet1").Cells(rowNumber, colNumber) <> "" Then
        i = i + 1
        'Worksheets(NewSheet).Cells(i, 1) = Worksheets("Sheet1").Cells(1, colNumber)
        Worksheets(ListName).Cells(i, 1) = Worksheets("Sheet1").Cells(1, colNumber)
    End If

Next colNumber
Next rowNumber
End Sub