Question

如何用vba将一个excel文件中一列中所有的项导入另一个excel文件中

我有名为A和B的两个excel文档

在A中的A列，有16000个数据。我希望通过B文件的vba编程将A文件中A列的所有数据，录入到B文件的A列中。

需要注意的地方：
1.A文件会每周更新，且A文件A列里的数据量是在不断变化的。不是固定的16000。我需要它有多少，就复制多少到B文件的A列中。
2.我希望B文件提取A文件数据并录入到B文件A列表这个程序过程是可以控制的，就好比是一个方块添加了一个宏。我点一下，它才运行一样。

我曾经尝试过用index函数来提取一列，但是这样不能提取有限的16000的条目，而是一整列上百！万个条目，为B文件后续的函数计算大大的增加了运算量，降低了运算效率。所以我希望是提取有限的全部的项，而不是一整列。
谢谢！！
我不怎么会vba,麻烦告诉我操作步奏，满意追赏

Answer 1

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim wk1 As Workbook, sh1 As Worksheet, wk2 As Workbook, sh2 As Worksheet
    Filename = Application.GetOpenFilename(fileFilter:="Excel File (*.xlsx), *.xlsx,Excel File(*.xls), *.xls", FilterIndex:=2, Title:="请选择文件")
    If Filename = False Then
    Else
        Workbooks.Open (Filename)
        Set wk1 = ThisWorkbook
        Set sh1 = wk1.ActiveSheet
        Set wk2 = ActiveWorkbook
        Set sh2 = ActiveSheet
        sh2.[a:a].Copy sh1.[a:a]
        wk2.Close savechanges:=False
        MsgBox "数据导入成功！"
    End If
End Sub

追问

这个方法解决了我所提出的问题，但还是没能解决我的最终目的，故追问一下。
我的根本的问题，是希望一个公式应用到一列中有值的最后一项。通常通过拖动单元格右下角的“+”符号，或者双击这个符号让公式适用于一整列来实现。
然而当我一列有几万项时，拖动“+”就不方便，而且当公式复杂，将此公式适用于一整列会大大增加计算量。
所以再问下，将某个公式适用于某一列的最后一个有值单元格，并且就此终止该怎样实现。

追答

如果数据量大，又要从其它工作薄中获取数据，那么，使用公式是不可取的。因为会拖慢系统的运行。甚至根本无法正常工作。
不明白你的意思，你的意思是想在原来的数据下面追加数据吗？

追问

我目前已经解决了。你给的代码很有帮助，有个小问题，如果我想提取A表第A, G, L 3列到B文件的ABC3列，代码该怎么改呢？

追答

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim wk1 As Workbook, sh1 As Worksheet, wk2 As Workbook, sh2 As Worksheet, r1%, r2%
    Filename = Application.GetOpenFilename(fileFilter:="Excel File (*.xlsx), *.xlsx,Excel File(*.xls), *.xls", FilterIndex:=2, Title:="请选择文件")
    If Filename = False Then
    Else
        Workbooks.Open (Filename)
        Set wk1 = ThisWorkbook
        Set sh1 = wk1.ActiveSheet
        Set wk2 = ActiveWorkbook
        Set sh2 = ActiveSheet
        r1 = sh1.[a1048576].End(3).Row + 1
        r2 = sh2.[a1].End(4).Row
        sh2.Range("A1:A" & r2).Copy sh1.Range("A" & r1)
        sh2.Range("G1:A" & r2).Copy sh1.Range("B" & r1)
        sh2.Range("L1:A" & r2).Copy sh1.Range("C" & r1)
        wk2.Close savechanges:=False
        MsgBox "数据导入成功！"
    End If
End Sub