Excel VBA:基于单元格值从选定工作簿复制粘贴
我想根据单元格值从选定的不同工作簿复制数据,并将其粘贴到单个工作簿中Excel VBA:基于单元格值从选定工作簿复制粘贴,excel,vba,Excel,Vba,我想根据单元格值从选定的不同工作簿复制数据,并将其粘贴到单个工作簿中 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 S
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
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)
这可能更适合您在评论中提到的内容:
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
试试这个:
在不同的地方使用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
集合x=A&i将抛出编译错误:类型不匹配,您可以自己尝试。另外,您还没有声明B。我在集合w=A&i&B处收到类型不匹配错误-问题不是B未声明。基本上,字符串就是编译器看到文本的方式,而工作簿实际上是一个对象,比如一个包含属性、值等的框。我的完整要求是:以下是编译器看到的内容:WorkbooksTE copypaste.xlsx.SheetsPortfolio1.RangeCells1,1,Cells8,14=WorkbookPortfolio1.xlsx.WorksheetDownload1.RangeA1:H141根据单元格值将多张工作表添加到当前工作簿Ex:cell值为2,然后添加两张工作表。2基于相同单元格值从文件夹中打开工作簿例如:如果单元格值为2,则打开2个工作簿3将数据从打开的工作簿复制到当前工作簿。在这种情况下,从两个不同的工作簿到当前工作簿,但在两个不同的工作表中。我无法在第三步创建循环。请帮助我。它抛出了不匹配@Set w=A&i&Yes,因为我认为这是工作簿的一个全新名称,并且您尚未创建或打开任何具有类似名称的工作簿,因此无法设置它。
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