Excel VBA 复制整列的内容到新的工作表的指定列

Excel VBA 复制整列的内容到新的工作表的指定列

Sub 复制整列的内容到新的工作表的指定列()
    Dim i,arr
    for i=1 to 6
        WorkBooks.Open(i)
        arr=ThisWorkBook.Sheets(1).Columns(i)
        ActiveSheet.Columns(1)=arr
        ActiveWorkBook.Close savechange:=True
    next i
End Sub

EXCEL将不同工作簿指定列的内容复制到一张工作表中

Sub 汇总()
    cPath = ThisWorkbook.Path & "\"
    myFile = Dir(cPath & "*.xlsx")
    Application.ScreenUpdating = False
    [a2].Resize(Cells(Rows.Count, 1).End(xlUp).Row + 10, 11).ClearContents
    Do While myFile <> ""
        If myFile <> ThisWorkbook.Name Then
            Set wb = GetObject(cPath & myFile)
            With wb.Sheets(1)
                nR = .Cells(Rows.Count, 1).End(xlUp).Row
                If nR > 1 Then arr = .[a2].Resize(nR - 1, 10)
            End With
            wb.Close False
            Set wb = Nothing
            nR1 = Cells(Rows.Count, 1).End(xlUp).Row
            Cells(nR1 + 1, 1).Resize(nR - 1, 10) = arr
            Cells(nR1 + 1, 11).Resize(nR - 1, 1) = myFile
        End If
        myFile = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "汇总完毕！", vbInformation, "提示"
End Sub