Код VBA не использует точный основной лист при повторном цикле во второй, третий раз

#excel #vba

#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:="<>" amp; 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
  

Комментарии:

1. Код выглядит неполным

2. Обновлено, не уверен, почему это произошло.

3. Вы смешиваете концепции sourceSheet и targetSheet. Пожалуйста, поэтапно объясните, чего вы хотите достичь с помощью «Счетов» и определенных вами диапазонов.