VBA创建一个EXCEL文件,并将当前文档中的sheet复制到新建文件中

以下是一个示例VBA代码，可以创建一个新的Excel文件，并将当前文档中的所有sheet复制到新文件中：

Sub CopyAllSheetsToNewWorkbook()
Dim newWorkbook As Workbook
Set newWorkbook = Workbooks.Add

Dim currentSheet As Worksheet
For Each currentSheet In ThisWorkbook.Worksheets
currentSheet.Copy After:=newWorkbook.Sheets(newWorkbook.Sheets.Count)
Next currentSheet

newWorkbook.SaveAs "C:\NewWorkbook.xlsx"
newWorkbook.Close

MsgBox "All sheets copied to new workbook"
End Sub

这个代码中，首先创建了一个新的Excel文件对象newWorkbook，然后使用For Each循环遍历当前文档中所有的sheet，并将其复制到新文件中。最后，将新文件保存到特定的路径，并关闭文件。

相关问题

如何用VBA把Excel的表格复制到文档

要用 VBA 将 Excel 表格复制到文档，可以按照以下步骤进行：

1. 打开 Excel 文件并按 ALT + F11 组合键打开 VBA 编辑器。

2. 在 VBA 编辑器中，选择插入 -> 模块，然后在新建模块中添加以下代码：

Sub CopyTableToWord()
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim wdRange As Object

    '创建 Word 应用程序
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True

    '打开 Word 文档
    Set wdDoc = wdApp.Documents.Open("C:\Users\Documents\Test.docx")

    '选择要插入表格的位置
    Set wdRange = wdDoc.Range(Start:=0, End:=0)

    '复制 Excel 表格
    ThisWorkbook.Sheets("Sheet1").Range("A1:D10").Copy

    '在 Word 中粘贴表格
    wdRange.PasteExcelTable False, True, False
End Sub

3. 修改代码中的文档路径和表格范围，然后运行该宏即可将 Excel 表格复制到 Word 文档中。

注意：在运行该宏之前，请确保 Word 中已经打开了目标文档，并且 Excel 中的表格范围已经正确设置。

请写一段VBA代码，帮我解决以下问题：我在桌面有一个文件夹名为“新建文件夹检索”，这个文件夹中有多个exl表格，每个表格中有多个sheet，请在文件夹中的所有sheet中检索文本“特瑞普利单抗”，并统计文本“特瑞普利单抗”出现的次数，将结果写入到一个新的exl文档中，该文档创建在桌面，命名为“新建文件夹检索结果”。注意，“特瑞普利单抗”可能是单元格中数据的一部分片段，这样也计入次数。结果的书写方式是每个sheet分别列出。

以下是VBA代码实现您的需求：

Sub SearchAndCount()
    Dim searchFolder As String '要搜索的文件夹路径
    Dim resultFile As String '结果文件路径
    Dim searchText As String '待搜索的文本
    Dim count As Long '计数器
    Dim wb As Workbook '工作簿对象
    Dim ws As Worksheet '工作表对象
    Dim newWb As Workbook '新建的工作簿对象
    Dim newWs As Worksheet '新建的工作表对象
    Dim row As Long '行计数器
    
    '设置要搜索的文件夹路径和待搜索的文本
    searchFolder = "C:\Users\Username\Desktop\新建文件夹检索\"
    resultFile = "C:\Users\Username\Desktop\新建文件夹检索结果.xlsx"
    searchText = "特瑞普利单抗"
    
    '创建新的工作簿和工作表
    Set newWb = Workbooks.Add
    Set newWs = newWb.Sheets(1)
    
    '在新建的工作表中写入表头
    newWs.Range("A1").Value = "Sheet名称"
    newWs.Range("B1").Value = "计数"
    
    '遍历文件夹中的所有excel文件
    Dim file As String
    file = Dir(searchFolder & "*.xls*")
    Do Until file = ""
        Set wb = Workbooks.Open(searchFolder & file) '打开文件
        For Each ws In wb.Sheets '遍历所有工作表
            count = 0 '重置计数器
            For Each cell In ws.UsedRange '遍历工作表中所有单元格
                If InStr(1, cell.Value, searchText, vbTextCompare) > 0 Then '如果单元格中包含待搜索的文本
                    count = count + 1 '计数器加1
                End If
            Next cell
            '将结果写入新建的工作表中
            row = newWs.Cells(Rows.Count, 1).End(xlUp).Row + 1 '获取下一个空行
            newWs.Cells(row, 1).Value = ws.Name '写入工作表名称
            newWs.Cells(row, 2).Value = count '写入计数结果
        Next ws
        wb.Close False '关闭文件，不保存
        file = Dir '获取下一个文件
    Loop
    
    '保存并关闭新建的工作簿
    newWb.SaveAs resultFile
    newWb.Close
End Sub

您只需要将代码中的文件夹路径和待搜索的文本替换成您的实际路径和文本，然后运行该宏即可实现您的需求。注意，如果您的电脑中没有安装Excel软件，则无法运行该代码。