将多个列从一个工作簿转移到另一个工作簿

塔可钟

我想将多个列转移到名为“我的数据”的新工作簿中，并将其分别转移到指定的列。我已经尝试过此代码，但是它太长了，我想尝试使其简短，一旦过程完成，我想关闭新工作簿，也不确定如何操作。

Sub transfer()
Dim MyData As Workbook
Dim DataWs As Worksheet
Dim myWs As Worksheet
Set myWs = ThisWorkbook.Sheets("FinalinputFile")
Set MyData = Workbooks.Open("D:\Desktop\My\MyData.xlsx")
Set DataWs = MyData.Sheets("Data")
myWs.Range("C3:C11000").Copy
DataWs.Range("E2").PasteSpecial xlPasteAll

Set myWs = ThisWorkbook.Sheets("FinalinputFile")
Set MyData = Workbooks.Open("D:\Desktop\My\MyData.xlsx")
Set DataWs = MyData.Sheets("Data")
myWs.Range("E3:E11000").Copy
DataWs.Range("F2").PasteSpecial xlPasteAll

Set myWs = ThisWorkbook.Sheets("FinalinputFile")
Set MyData = Workbooks.Open("D:\Desktop\My\MyData.xlsx")
Set DataWs = MyData.Sheets("Data")
myWs.Range("G3:G11000").Copy
DataWs.Range("G2").PasteSpecial xlPasteAll

Set myWs = ThisWorkbook.Sheets("FinalinputFile")
Set MyData = Workbooks.Open("D:\Desktop\My\MyData.xlsx")
Set DataWs = MyData.Sheets("Data")
myWs.Range("I3:I11000").Copy
DataWs.Range("H2").PasteSpecial xlPasteAll

Set myWs = ThisWorkbook.Sheets("FinalinputFile")
Set MyData = Workbooks.Open("D:\Desktop\My\MyData.xlsx")
Set DataWs = MyData.Sheets("Data")
myWs.Range("K3:K11000").Copy
DataWs.Range("I2").PasteSpecial xlPasteAll

Set myWs = ThisWorkbook.Sheets("FinalinputFile")
Set MyData = Workbooks.Open("D:\Desktop\My\MyData.xlsx")
Set DataWs = MyData.Sheets("Data")
myWs.Range("M3:M11000").Copy
DataWs.Range("J2").PasteSpecial xlPasteAll


Set myWs = ThisWorkbook.Sheets("FinalinputFile")
Set MyData = Workbooks.Open("D:\Desktop\My\MyData.xlsx")
Set DataWs = MyData.Sheets("Data")
myWs.Range("U3:U11000").Copy
DataWs.Range("M2").PasteSpecial xlPasteAll


  MyData.Save

  End Sub

瑟琳

这部分代码

Set myWs = ThisWorkbook.Sheets("FinalinputFile")
Set MyData = Workbooks.Open("D:\Desktop\My\MyData.xlsx")
Set DataWs = MyData.Sheets("Data")

即使在每次都相同的情况下被重复，您的代码没有它也应该没问题，因此您可以通过删除重复来缩短代码。

另外，关闭工作簿的代码是，Workbooks("MyData").Close但是您必须保存它，最好像这样称呼全名Workbooks("MyData").Save

所以你的最终代码看起来像

Sub transfer()
Dim MyData As Workbook
Dim DataWs As Worksheet
Dim myWs As Worksheet
Set myWs = ThisWorkbook.Sheets("FinalinputFile")
Set MyData = Workbooks.Open("D:\Desktop\My\MyData.xlsx")
Set DataWs = MyData.Sheets("Data")

myWs.Range("C3:C11000").Copy
DataWs.Range("E2").PasteSpecial xlPasteAll
myWs.Range("E3:E11000").Copy
DataWs.Range("F2").PasteSpecial xlPasteAll
myWs.Range("G3:G11000").Copy
DataWs.Range("G2").PasteSpecial xlPasteAll
myWs.Range("I3:I11000").Copy
DataWs.Range("H2").PasteSpecial xlPasteAll
myWs.Range("K3:K11000").Copy
DataWs.Range("I2").PasteSpecial xlPasteAll
myWs.Range("M3:M11000").Copy
DataWs.Range("J2").PasteSpecial xlPasteAll
myWs.Range("U3:U11000").Copy
DataWs.Range("M2").PasteSpecial xlPasteAll 

Workbooks("MyData").Save
Workbooks("MyData").Close

End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。