将列复制到新工作簿

时间:2019-02-20 13:21:47

标签: excel vba windows

我正在尝试在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开头,依此类推...

1 个答案:

答案 0 :(得分:0)

此代码应指导您正确的方向。注释已添加到代码中。

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