将数据从一个工作簿复制到其他工作簿

Question

谢谢您的帮助！ 如何更改此代码以将数据复制到现有工作簿（它们唯一的区别是.xlsm格式，文件名是1.xlsm，...，50.xlsm）而不是创建新文件（所有文件都位于同一文件夹）？ 如果还有更多的单元格（每5个单元格，从B2开始lm = Range("B2,G2,L2")那么如何指定范围lm = Range("B2,G2,L2") ）？

我试图使用Workbooks.Open ("1.xlsm") Workbooks.Open ("2.xlsm")等将数据复制到现有工作Workbooks.Open ("1.xlsm") ，并且必须将其保存时在名称中添加& ".xlsm" （如SaveAs ）。

Sub CopyM()
  Dim lm As Range, r As Long, c As Long
  Set lm = Range("B2,G2,L2"):  Application.ScreenUpdating = False
  For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    Workbooks.Add
    For c = 0 To 4
      lm.Offset(r - 2, c).Copy Cells(r + c, 2)
    Next
    With Workbooks(Workbooks.Count)
      .SaveAs lm.Offset(r - 2, -1).Value: .Close
    End With
  Next
  Application.ScreenUpdating = True
End Sub

Answer 1

我怀疑您的问题是，一旦打开它，您需要一种方法来引用正确的工作簿。 这样做的方法是将workbook分配给一个对象变量，然后在每次需要引用该工作簿时都使用该变量：

Dim wb as Workbook
Set wb = Workbooks.Open("yourfilename.xlsx")
'...
  lm.Offset(r - 2, c).Copy wb.Cells(r + c, 2)
'...
With wb
  .SaveAs lm.Offset(r - 2, -1).Value: .Close
End With

要将其他单元格添加到range ，您可以键入其他单元格引用，并用逗号分隔（例如Range("B2,G2,L2,Q2,V2") ）。 如果这些单元格从未发生变化，则可以。 另外，为获得更大的灵活性，您可以使用Union()函数在循环中向lm添加其他单元格，例如：

Dim col As Long
Dim lm As Range
Set lm = Range("B2")
For col = 7 To 256 Step 5
  Set lm = Union(lm, Cells(2, col))
Next col