第二次,第三次循环时,VBA代码未使用准确的母版表

时间:2019-03-07 22:35:01

标签: excel vba

我创建的VBA正在创建单独的图纸。但是(在此示例中,将创建三张表),在创建第一张表并在VBA中运行代码后,它将复制已创建的第一张表,而不是主表,而该主表已具有所需的数据。第二个和第三个标签被过滤掉,因此最后两个标签中没有数据。你知道是什么原因造成的吗?下面的代码:

Option Explicit

Sub InvoiceSeperator()

    ' Declare objects
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRange As Range
    Dim targetRange As Range
    Dim SplitOrderNum As Range
    Dim OrderData As Range
    Dim sourceCell As Range
    Dim allOrders As Range
    Dim invoicenumbers As Range

    ' Declare other variables
    Dim sourceSheetName As String
    Dim sourceRangeName As String
    Dim targetSheetName As String
    Dim targetRangeName As String

    Dim lastSheetHidden As Boolean

    ' <<< Customize this >>>
    sourceSheetName = "Invoices"
    targetSheetName = "SumToLineItem"
    sourceRangeName = "SplitOrderNum"
    targetRangeName = "OrderData"

    ' Initialize the source sheet
    Set targetSheet = ThisWorkbook.Sheets("SumToLineItem")

    Set allOrders = targetSheet.Range("B:B")
    allOrders.Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    Sheets(2).Select
    Sheets(2).Name = "Invoices"
    Application.CutCopyMode = False
    ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes

    Set sourceSheet = ThisWorkbook.Sheets("Invoices")
    sourceSheet.Range("A2").Select
    sourceSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Names.Add Name:="SplitOrderNum", RefersToR1C1:= _
        "=Invoices!R2C1:R4C1"

    ' Initialize the range (Add full qualifier to the current workbook, sheet and range)
    Set sourceRange = sourceSheet.Range("SplitOrderNum")
    ' Get if last sheet is visible in current workbook
    lastSheetHidden = Not ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Visible
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Visible = True

    For Each sourceCell In sourceRange
        ' Copy the source worksheet
        targetSheet.Copy After:=Worksheets(ThisWorkbook.Sheets.Count)
        ' Rename the new worksheet
        Sheets(ThisWorkbook.Sheets.Count).Name = sourceCell.Value
        ' Reference to the added worksheet
        Set targetSheet = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

        With targetSheet.Range(targetRangeName)
            .AutoFilter Field:=2, Criteria1:="<>" & sourceCell.Value,.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With

        ' Check this next line if this should point to the orderdata range too (?)
        targetSheet.AutoFilter.ShowAllData

    Next sourceCell

    ' Return the last sheet visible state
    If lastSheetHidden = False Then
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Visible = Not lastSheetHidden
    End If

End Sub

0 个答案:

没有答案