我编写了以下代码来清理工作簿,然后创建空工作表
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 文件并复制到名称在 中的 crate 工作表
我写了以下
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
最佳答案
要解决第一个问题,请尝试:
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
关于vba - 将文件夹中的不同工作簿复制到一个工作簿中的不同工作表中,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/38993323/