怎样将excel表格内所有工作簿统一拆分为单个工作簿
Posted
tags:
篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了怎样将excel表格内所有工作簿统一拆分为单个工作簿相关的知识,希望对你有一定的参考价值。
参考技术A 将Excel工作簿中所有工作表拆分成单个的工作簿,方法有三种:第一种:手动移动复制工作表,建立副本;
第二种:通过录制宏,录制第一种方法;
第三种:利用WPS表格的拆分表格功能。
VBA代码根据列的内容将excel文件拆分为多个工作簿?
我对VBA没有经验,但我认为这是实现这一目标的唯一途径。
我需要向每个销售团队发送报告,但不想向他们发送其他销售团队的信息。每个工作簿有多个工作簿,其中包含不同的报表,这些工作簿都包含销售团队列。
我希望销售团队过滤所有工作表,并为每个团队创建一个新工作簿。
我感谢任何帮助。
答案
我有这个解决方案。 如果您需要此解决方案,请给我发送电子邮件。
起初我得到了这种格式: 我创建以下宏代码
Option Explicit
Dim MainWorkBook As Workbook
Dim NewWorkBook As Workbook
Sub ExportWorksheet()
Dim Pointer As Long
Set MainWorkBook = ActiveWorkbook
Range("E2").Value = MainWorkBook.Sheets.Count
Application.ScreenUpdating = False 'enhance the performance
For Pointer = 2 To MainWorkBook.Sheets.Count
Set NewWorkBook = Workbooks.Add
MainWorkBook.Sheets(Pointer).Copy After:=NewWorkBook.Sheets(1)
Application.DisplayAlerts = False
NewWorkBook.Sheets(1).Delete
Application.DisplayAlerts = True
With NewWorkBook
.SaveAs Filename:="C:UserslengkganDesktopTesting" & MainWorkBook.Sheets(Pointer).Name & ".xls" 'you may change to yours
End With
NewWorkBook.Close SaveChanges:=True
Next Pointer
Application.ScreenUpdating = True
Range("D5").Value = "Export Completed"
End Sub
以下是输出
另一答案
我编写了一个基于输入数据的VBA(宏)程序。您需要做的就是在另一个工作表的列中提供输入数据。宏将根据每行读取数据并过滤主表,然后根据查找数据生成新的Excel表。
enter Option Explicit
Dim personRows As Range 'Stores all of the rows found
'Split data into separate columns baed on the names defined in
'a RepList on the 'Names' sheet.
Sub SplitSalesData()
Dim wb As Workbook
Dim p As Range
Dim counter2 As Integer
Dim i As Integer
counter2 = 0
i = 0
Application.ScreenUpdating = False
' in my case i am generating new excel based on every 8 reacords from begining. You can simplyfy this logic based on your need.
For Each p In Sheets("Names").Range("RepList") ' Give the name of your input sheet and column
If i = 0 Then ' We are starting, so generate new excel in memeory.
Workbooks.Add
Set wb = ActiveWorkbook
ThisWorkbook.Activate
End If
WritePersonToWorkbook wb, p.Value
i = i + 1 ' Increment the counter reach time
If i = 8 Then ' As my need is after processing every 8 uniqe record just save the excel sheet and reset the processing
counter2 = counter2 + 1
wb.SaveAs ThisWorkbook.Path & "salesdata_" & CStr(counter2) ' save the data at current directory location.
wb.Close
Set personRows = Nothing ' Once the process has completed for curent excelsheet, set the personRows as NULL
i = 0
End If
Next p
Application.ScreenUpdating = True
Set wb = Nothing
End Sub
'Writes all the data rows belonging to a RepList
Sub WritePersonToWorkbook(ByVal SalesWB As Workbook, _
ByVal Person As String)
Dim rw As Range
Dim firstRW As Range
For Each rw In UsedRange.Rows
If Not Not firstRW Is Nothing And Not IsNull(rw) Then
Set firstRW = rw ' WE want to add first row in each excel sheet.
End If
If Person = rw.Cells(1, 5) Then ' My filter is working based on "FeederID"
If personRows Is Nothing Then
Set personRows = firstRW
Set personRows = Union(personRows, rw)
Else
Set personRows = Union(personRows, rw)
End If
End If
Next rw
personRows.Copy SalesWB.Sheets(1).Cells(1, 1) ' Adding data in Excel sheet.
End Sub
以上是关于怎样将excel表格内所有工作簿统一拆分为单个工作簿的主要内容,如果未能解决你的问题,请参考以下文章
excel或者vba,怎样将工作簿内所有橙色单元格公式转换为数值?
在 R 中拆分大型数据框并输出到单个 Excel 工作簿中的单独工作表中