Копировать столбцы в новую книгу

Question

Я пытаюсь кодировать в VBA систему, которая в основном копирует столбцы и вставляет ее в другую книгу, но у меня есть некоторые особенности.

Я попытаюсь объяснить логическое представление о том, как должна работать система:

Select A2 Cell

Select Column A to Cell An #<*different*># from An+1
-example      A
        A1   hey
        A2   hey
        A3   hey
        A4   hey
        A5   ho
            So it would select till line 4.

Select all info from Column "D" from Cell "D2" to "Dn"

Copy

Open a new workbook

Paste into cell "A2" (New Workbook)

Select all info from Column "E" from Cell "E2" to "En" (First Workbook)

Copy

Paste into cell "B2" (New Workbook)

Select all info from Column "F" from Cell "F2" to "Fn" (First Workbook)

Copy

Paste into cell "C2" (New Workbook)

Select all info from Column "G" from Cell "G2" to "Gn" (First Workbook)

Copy

Paste into cell "D2" (New Workbook)

Select all info from Column "H" from Cell "H2" to "Hn" (First Workbook)

Copy

Paste into cell "F2" (New Workbook)

Select all info from Column "I" from Cell "I2" to "In" (First Workbook)

Copy

Paste into cell "G2" (New Workbook)

Save and close the "New Workbook"

Repeat the process analyzing from An+1 to the next different Cell.

Столбцы copy не начнутся с Cell2, вместо этого начнутся с Celln+1 и так далее ...

Answer 1

Этот код должен направить вас в правильном направлении.Комментарии добавляются в код.

Sub CpyColstoNewWB()
Dim x As Long, i As Long
Dim wb As Workbook

Set wb = Workbooks.Add 'Create new workbook

ThisWorkbook.Activate 'Reset the focus

    With Sheets("Sheet1")
    c = 1 'set the col # in the new workbook sheet1
        For x = 4 To 6 'used to loop through col #s
            i = 1 'sets the initial row to start from
                Do Until Cells(i, x) <> .Cells(i + 1, x) 'test the current cell to the cell below it
                        i = i + 1 'if the condition is not met, will loop to the next row
                Loop

            'If the condition is met, will accomplish the below line of code and then start on the next col
            .Range(.Cells(1, x), .Cells(i, x)).Copy wb.Sheets("Sheet1").Cells(2, c)

            c = c + 1 'adds 1 to the col # to move to the next col
        Next x 'go to the next col
    End With
End Sub