我一次只从一个列导入另一个工作簿中的数据。通过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").Copy Range("B2") Workbooks("February2014").Sheets("Sheet2").Range("B2:B13").Copy Range("C2")
End Sub