Excel VBA一步导入其他工作簿中的数据

时间:2017-10-16 15:25:18

标签: excel-vba vba excel

我一次只从一个列导入另一个工作簿中的数据。通过VBA,可以一次完成重要的几个列。我需要复制的列及其目的地不一定按时间顺序或字母顺序排列。因此,可能必须将列A复制到目标工作簿/工作表中的列P.

这是我目前在两个工作簿之间来回传递的代码:

Sub GetFile()                 

    Windows("Status Report Internal 2017-09-29.xlsm").Activate

    Range("A2:A10000").Select
    Selection.Copy
    Windows("MDC 2017.xls").Activate
    Sheets("Data").Select
    Range("A8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False     

    Windows("Status Report Internal 2017-09-29.xlsm").Activate

    Range("B2:B10000").Select
    Selection.Copy
    Windows("MDC 2017.xls").Activate
    Range("B8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("Status Report Internal 2017-09-29.xlsm").Activate

    Range("Z2:Z10000").Select
    Selection.Copy
    Windows("MDC 2017.xls").Activate
    Range("C8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("Status Report Internal 2017-09-29.xlsm").Activate

    Range("D2:D10000").Select
    Selection.Copy
    Windows("MDC 2017.xls").Activate
    Range("D8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("D8:D10000").Select
    Selection.Replace What:="NO ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="RFS ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Windows("Status Report Internal 2017-09-29.xlsm").Activate

    Range("F2:F10000").Select
    Selection.Copy
    Windows("MDC 2017.xls").Activate
    Range("F8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("F8:F10000").Select
    Selection.Replace What:="On Hold", Replacement:="On hold", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Windows("Status Report Internal 2017-09-29.xlsm").Activate

    Range("H2:H10000").Select
    Selection.Copy
    Windows("MDC 2017.xls").Activate
    Range("G8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("Status Report Internal 2017-09-29.xlsm").Activate

    Range("J2:J10000").Select
    Selection.Copy
    Windows("MDC 2017.xls").Activate
    Range("H8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("Status Report Internal 2017-09-29.xlsm").Activate

    Range("N2:N10000").Select
    Selection.Copy
    Windows("MDC 2017.xls").Activate
    Range("I8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("Status Report Internal 2017-09-29.xlsm").Activate

    Range("O2:O10000").Select
    Selection.Copy
    Windows("MDC 2017.xls").Activate
    Range("J8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("Status Report Internal 2017-09-29.xlsm").Activate

    Range("P2:P10000").Select
    Selection.Copy
    Windows("MDC 2017.xls").Activate
    Range("K8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("Status Report Internal 2017-09-29.xlsm").Activate

    Range("Q2:Q10000").Select
    Selection.Copy
    Windows("MDC 2017.xls").Activate
    Range("L8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("Status Report Internal 2017-09-29.xlsm").Activate

    Range("V2:V10000").Select
    Selection.Copy
    Windows("MDC 2017.xls").Activate
    Range("M8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False       

End Sub

我正在尝试使用我在YouTube上找到的此代码,但出于某种原因,它无法正常工作:

Sub CopyingRange() 

Workbooks("January2014").Sheets("Sheet2").Range("B2:B13").Co‌​py Range("B2") Workbooks("February2014").Sheets("Sheet2").Range("B2:B13").C‌​opy Range("C2") 

End Sub 

0 个答案:

没有答案