• 该宏会将文件夹C:\ Data中每个文件的第一工作表的一部分复制到工作簿的第一工作表中。

  • 第一个宏执行普通复制,第二个宏复制值。

它将复制每个工作簿的第一张纸到代码所在的工作簿中。工作表名称是工作簿的名称。

对于此sub(TestFile4_values),您必须具有未保护的工作表,或在代码中取消保护它们。

Sub CopySheet()

Dim basebook As Workbook

Dim mybook As Workbook

Dim i As Long

Application.ScreenUpdating = False

With Application.FileSearch

.NewSearch

.LookIn = "C:\Data"

.SearchSubFolders = False

.FileType = msoFileTypeExcelWorkbooks

If .Execute() > 0 Then

Set basebook = ThisWorkbook

For i = 1 To .FoundFiles.Count

Set mybook = Workbooks.Open(.FoundFiles(i))

mybook.Worksheets(1).Copy after:= _

basebook.Sheets(basebook.Sheets.Count)

ActiveSheet.Name = mybook.Name

mybook.Close

Next i

End If

End With

Application.ScreenUpdating = True

End Sub
Sub CopySheetValues()

Dim basebook As Workbook

Dim mybook As Workbook

Dim i As Long

Application.ScreenUpdating = False

With Application.FileSearch

.NewSearch

.LookIn = "C:\Data"

.SearchSubFolders = False

.FileType = msoFileTypeExcelWorkbooks

If .Execute() > 0 Then

Set basebook = ThisWorkbook

For i = 1 To .FoundFiles.Count

Set mybook = Workbooks.Open(.FoundFiles(i))

mybook.Worksheets(1).Copy after:= _

basebook.Sheets(basebook.Sheets.Count)

ActiveSheet.Name = mybook.Name

With ActiveSheet.UsedRange

.Value = .Value

End With

mybook.Close

Next i

End If

End With

Application.ScreenUpdating = True

End Sub