循环单元格在范围内，区域中的每个单元格复制并粘贴到多个工作簿。
循环单元格在范围内，区域中的每个单元格复制并粘贴到多个工作簿。
提问于 2020-07-05 07:22:51
VBA Excel中有一个任务。
- 在Excel文件“列表”中，循环遍历范围内的单元格。范围(" B2 : B4“)。
- 复制单元格B2在文件”列表“中，粘贴到Excel-文件”1“中的单元格A2中。
- 复制单元格B3在文件”列表“中，粘贴到Excel-文件”2“中的单元格A2中。
- 在文件”列表“中复制单元格B4，在Excel-文件”3“中粘贴到单元格A2。所有这些都将使用循环。问题在于文件“列表”复制范围内的循环单元格与目录路径(Excel文件1、2、3)中的循环工作簿一起工作，用于粘贴.
。
这个范围实际上包含将近1,600个单元格。但我把它简化了来理解这个问题。
请帮忙解决这个问题。
示例文件附呈。有一个代码(下面)，但它不工作。
Sub KopirovanieIVstavkaVRaznyeWorkbook()
Dim MyRange As Range
Dim MyCell As Range
Dim MyFiles As String
Set MyRange = Application.Workbooks(List.xlsm).Worksheets("Sheet1").Range("B2:B4")
For Each MyCell In MyRange
If MyCell > 0 Then
MyFiles = Dir("C:\Users\User\Desktop\Papka\*.xlsx")
Do While MyFiles <> “”
Workbooks.Open "C:\Users\User\Desktop\Papka\" & MyFiles
ActiveWorkbook.Worksheets(1).Range("A2") = MyCell
ActiveWorkbook.Close SaveChanges:=True
MyFiles = Dir
Exit Do
Loop
Else
MyCell.Offset(0, 1).Value = "Pusto"
End If
Next MyCell
End Sub回答 1
Stack Overflow用户
发布于 2020-07-05 11:01:54
尝尝这个
Sub KopirovanieIVstavkaVRaznyeWorkbook()
Dim MyRange As Range
Dim MyFile As String
Dim i As Long
Dim wb As Workbook
Set MyRange = ThisWorkbook.Sheets("Sheet1").Range("B2:B4")
With MyRange
For i = 1 To .Rows.Count
' Assumes Excel files are named "Excel-file n.xlsx", where n is an integer
MyFile = "C:\Users\User\Desktop\Papka\Excel-file " & i & ".xlsx"
Set wb = Workbooks.Open(MyFile)
' Assume the target A1 is in the first sheet of the workbook
wb.Sheets(1).Range("A1").Value = .Cells(i, 1).Value
wb.Close SaveChanges:=True
.Cells(i, 1) = "Pusto"
Next i
End With
End Sub请注意这些假设
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/62737930
复制相关文章
相似问题
腾讯云开发者
