VBA：基於單元格的值

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

阿尼爾稱它，你就宣告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 

這可能是更適合您在您的評論中提到的：在使用 Debug.Print：

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

試試這個各種各樣的點更好地理解你的代碼。

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