Question

我想根据单元格值从选定的不同工作簿中复制数据并将其粘贴到一个工作簿

enter code here
Sub Ram_copypaste()
Dim w As Workbook
Dim A As String
Dim x As Worksheet
Dim j As Integer
Dim i As Integer
j = cells(2, 1).Value
A = "Portfolio"
B = ".xlsx"
For i = 1 To j
Set w = A & i & B
Set x = A & i
w.Worksheets("Download1").Range("A1:H14").Copy
Workbooks("TE copypaste.xlsx").x.cells(1, 1).PasteSpecial xlPasteValues
Next i
End Sub

Answer 1

Anil称之为，您将x声明为工作表

Dim x As Worksheet

但您尝试将其设置为等于字符串

A = "Portfolio"
For i = 1
Set x = A & i

除了作为工作簿之外，您还在使用W做同样的事情

也许尝试像

这样的东西

set w = Workbooks.Open(<path>\<filename>)
set x = w.sheets(A & I)

如果单元格（2,1）中的值不是数字，则会出现类型不匹配错误。

顶部的这篇文章会给你一些问题

enter code here

这可能更适合您在评论中提到的内容：

Sub test()

Dim workBookPath As String, filename As String
Dim i As Long, j As Long
Dim awb As Workbook, w As Workbook
Dim x As Worksheet

Set awb = ActiveWorkbook

workBookPath = "C:\users\mt390d\Documents\Reports\"
    If IsNumeric(Cells(2, 1)) Then
        j = Cells(2, 1).Value
        Else: MsgBox ("Cell A2 must contain a number")
        Exit Sub
    End If

For i = 1 To j
    filename = Dir(workBookPath)
    If filename <> awb.Name Then
        Set w = Workbooks.Open(workBookPath & filename)
        Sheets("Download1").Copy awb.Sheets(1)
        Set x = ActiveSheet
        On Error Resume Next
            x.Name = "Portfolio" & i
        On Error GoTo 0
        w.Close
    End If
    filename = Dir()
Next i

End Sub

Answer 2

试试这个：在各个点使用Debug.Print可以更好地理解您的代码。

Sub Ram_copypaste()
Dim w As Workbook
Dim A As String, B As String
Dim x As Worksheet
Dim j As Integer
Dim i As Integer

j = cells(2, 1).Value   'Use Debug.Print to check the value of J
A = "Portfolio"
B = ".xlsx"
For i = 1 To j
Set w = workbooks(A & i & B)   'Make sure you already have a workbook 
   'with the same name as A & i & B opened otherwise this will give error. If 
   'you don't have it opened but have it on your drive first open it and then set it.

set x = w.sheets(A & i)      'As suggested by Anil Kumar to avoid Type Mismatch error
w.Worksheets("Download1").Range("A1:H14").Copy
Workbooks("TE copypaste.xlsx").x.cells(1, 1).Select
Workbooks("TE copypaste.xlsx").x.cells(1, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Next i
End Sub

VBA：根据单元格值从选定的工作簿中复制粘贴

2 个答案: