Question

我必须在一个以短语＆＃34; BATCH＆＃34;开头的文件夹中浏览工作簿。将复制的单元格复制并插入到主工作簿中的一个工作表中。我试图使用我在网上找到的一个例子，但它不起作用。它没有做任何事情。

Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
.LookIn = "C:\Path"
.FileType = msoFileTypeExcelWorkbooks
.Filename = "BATCH*.xls"
If .Execute > 0 Then
For lCount = 1 To .FoundFiles.Count
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)

Workbooks(Filename).Worksheets("Data").Range("B23:Z38").Copy
ThisWorkbook.Worksheets("Sheet1").Range("B2").Rows("1:16").Insert Shift:=xlDown

wbResults.Close SaveChanges:=False
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

我还希望能够将一个文件放入任何文件夹中以执行此任务。

Answer 1

正如Andy G在他的评论中指出的那样，你忘记了粘贴。你的coude应该

Workbooks(Filename).Worksheets("Data").Range("B23:Z38").Copy
ThisWorkbook.Worksheets("Sheet1").Range("B2").Rows("1:16").Insert Shift:=xlDown
ThisWorkbook.Worksheets("Sheet1").Range("B2").Paste

编辑：自Application.FileSearch is gone as of Excel 2007以来，您可以尝试使用VBA Dir()函数的替代方法：

Sub RunCodeOnAllXLSFiles()
    Dim wbCodeBook As Workbook
    Dim myPath As String
    Dim myMask As String
    Dim fnResults As String
    Dim wbResults As Workbook

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    Set wbCodeBook = ThisWorkbook
    myPath = "C:\Path"
    myMask = "BATCH*.xls"

    fnResults = Dir(myPath & "\" & myMask) 'Get 1st match
    Do While fnResults <> ""
        Set wbResults = Workbooks.Open(myPath & "\" & fnResults, 0)
        Workbooks(fnResults).Worksheets("Data").Range("B23:Z38").Copy
        ThisWorkbook.Worksheets("Sheet1").Range("B2").Rows("1:16").Insert Shift:=xlDown
        ThisWorkbook.Worksheets("Sheet1").Range("B2").Paste
        fnResults = Dir 'Get next match
    Loop

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub

遍历文件夹中的工作簿以将单元格复制并插入到主工作簿中

1 个答案: