![](/img/trans.png)
[英]VBA Macro to copy/paste cell value from sheet 1 to 2 based on date
[英]VBA: copy paste from selected workbooks based on cell value
我想根據單元格值從選定的不同工作簿中復制數據,並將其粘貼到一個工作簿中
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)
如果cells(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
嘗試以下操作:在各個點使用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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.