从一个文件夹复制到不同的表在一个工作簿复制不同的工作簿

Question

我写了下面的代码清理工作簿，然后创建空表

Sub conclusion() 
Dim xWs As Worksheet 
Dim Path As String, Filename As String 



    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    For Each xWs In Application.ActiveWorkbook.Worksheets 
     If xWs.Name <> "Sheet1" And xWs.Name <> "Summary" Then 
      xWs.Delete 
     End If 
    Next 
    Application.DisplayAlerts = True 
    Application.ScreenUpdating = True 
    ' create new sheets 

    Dim MyCell As Range, MyRange As Range 

    Set MyRange = Sheets("Summary").Range("A2") 
    Set MyRange = Range(MyRange, MyRange.End(xlDown)) 

    For Each MyCell In MyRange 
     Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet 
     Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet 
    Next MyCell 

    ' copy the workbooks into the sheets (My question) 

End Sub 

，然后将其改为从细胞在我的情况的路径B2，查找所有的XLS文件这个文件夹中，并复制到装箱张他们的名字都在

我写了下面

Path= Sheets("Summary").Range("B2").Value ***(it does not read the value of B2, why?)*** 
    Filename = Dir("Path" & "*.xls") 
    Do While Filename <> "" 

***here is my question, how can I write the following: 
COPY THE WORKBOOK 1 INTO SHEET with the name from Cell A2*** 
    Loop 

Answer 1

要解决第一个问题的尝试：

With Application.Workbooks("BookName").Sheets("Summary") 
    Path = .Range("B1").Text & "\" & .Range("A2").Text 
End With 

对于第二个你的变量Path是在引号，它不应该是因为它不是一个字符串，而是一个字符串变量。也不太清楚为什么你不得不在那里无论是通配符星号...

Filename = Dir(Path & ".xls") 

对于最后一部分，你For Loop缺什么它是一个可通过（即细胞）

For Each MyCell In MyRange.Cells 
    Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet 
    Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet 
Next MyCell 

要循环