Excel VBA to import data from other workbook in on

2019-08-22 22:41发布

I'm importing data from another workbook one column at a time. Is it possible, via VBA, to important several columns in one go. The columns I need to copy from and their destination are not necessarily in cronological or alphabetic order. So, column A may have to be copied to column P in the destination workbook/worksheet.

This is my current code that goes back and forth between the two workbooks:

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

I was trying with this code I found on YouTube, but for some reason, it didn't work:

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条回答
登录 后发表回答