将工作簿拆分为单独的工作簿,包括所有选项卡

时间:2016-10-19 14:18:47

标签: excel vba excel-vba

我在这里的帖子上查看了Bhaskar的代码(VBA code to split an excel file into multiple workbooks based on the contents of a column?) 并将其修改为它识别我需要拆分工作簿的字段,但我在下一节中得到一个未定义的变量错误

对于UsedRange.Rows中的每个rw

感谢您提供的任何帮助

我已经包含了代码。

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("Source").Range("AM1") ' 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 - ***ERROR IS HERE***
    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

0 个答案:

没有答案