Ячейки Ai Bi (лист1) разгруппировать в Ai (лист2)

[Alexander_Gr]

Друзья, помогите начинающему программисту) Для облегченного понимания цикла я придумал такой пример, подскажите пожалуйста как его реализовать в макросе:

Имеются два столбца в лист1:
A1-An и B1-Bn

Мне нужно разруппировать их в один столбец A лист2 в такой последовательности:

Столбец A1 лист2:

A1(лист1)
B1(лист1)
A2(лист1)
B2(лист1)
A3(лист1)
B3(лист1)
A4(лист1)
B4(лист1)
A5(лист1)
B5(лист1)
.
.
.
An(лист1)
Bn(лист1)


Заранее благодарю за пример!

[Pavel55]

Точно не знаю, попробуйте так

Sub CombineValues()
Dim iLastRow&, i&, iRow&
    iLastRow = Sheets("Лист1").[A65536].End(xlUp).Row
    Sheets("Лист2").Columns(1).Clear
    For i = 1 To iLastRow
        iRow = iRow + 1
        Sheets("Лист2").Cells(iRow, 1) = Sheets("Лист1").Cells(i, 1)
        iRow = iRow + 1
        Sheets("Лист2").Cells(iRow, 1) = Sheets("Лист1").Cells(i, 2)
    Next i
    MsgBox "Done!", , ""
End Sub

[Alexander_Gr]

Павел все работает, только приходится завадать последнюю ячейку в столбце (A111) можно как то автоматически его определять?

И ещё, можно унифицировать, к примеру условие выполняется если ячейка не пуста? Как такое условие задается?

[Alexander_Gr]

Ещё вопрос Павел, можно сделать так что бы экспортировались данные не в лист2, а например в файл test.txt ?

[Pavel55]

Очень странно, что вам приходится задавать самому ячейку А111, т.к. в коде есть строка
iLastRow = Sh1.[A65536].End(xlUp).Row

т.е. ищется последняя строка на Лист1. Если это А111, то переменная iLastRow будет иметь значении 111. Пройтиде макрос пошагово с помощью клавиши F8, и посмотрите какое значение у вас принимает эта переменная.

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

Sub CombineValues()
Dim iLastRow&, i&, iRow&
Dim Sh1 As Worksheet
Dim NewSh As Worksheet

    Set Sh1 = Sheets("Лист1") 'лист с данными
    iLastRow = Sh1.[A65536].End(xlUp).Row 'последняя строка с данными
    Set NewSh = Workbooks.Add.Worksheets(1) 'создаём новую книгу с листом
    For i = 1 To iLastRow
        If Not IsEmpty(Sh1.Cells(i, 1)) Then
            iRow = iRow + 1
            NewSh.Cells(iRow, 1) = Sh1.Cells(i, 1)
        End If
        If Not IsEmpty(Sh1.Cells(i, 2)) Then
            iRow = iRow + 1
            NewSh.Cells(iRow, 1) = Sh1.Cells(i, 2)
        End If
    Next i
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="C:\Test.txt", FileFormat:=xlUnicodeText
    NewSh.Parent.Close False 'закрываем новый книгу, не сохраняя изменений
    Application.DisplayAlerts = True
    MsgBox "Done!", , ""
End Sub