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

Question

Thank you for your help! How to change this code to copy data to existing workbooks (the only difference they are in .xlsm format, the names of files are 1.xlsm,...,50.xlsm) not to create new ones (all files are in the same folder)? And how to specify range lm = Range("B2,G2,L2") if there are more cells (every 5-th cell, starting from B2)?

I've tried to copy data to existing workbooks using Workbooks.Open ("1.xlsm") Workbooks.Open ("2.xlsm") etc. and when it must be saved adding & ".xlsm" to the name (as 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

I suspect your problem is that you need a way to refer to the correct workbook once you've opened it. The way to do this is by assigning the workbook to an object variable, then use that variable every time you need to refer to the 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

For adding extra cells to the range , you could just type additional cell references separated by commas (eg Range("B2,G2,L2,Q2,V2") ). This is ok if those cells don't ever change. Alternatively for more flexibility you can add additional cells to lm in a loop using the Union() function, eg:

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