VBA: перенос данных с одного листа на другой с "диапазоном перемещения"

Question

Я пытаюсь создать панель управления моей системой инвентаризации. На панели инструментов будут отображаться продажи за день (категория 1), покупки, которые необходимо совершить (категория 2), заказы на покупку, которые следует ожидать (категория 3), и незавершенное производство (категория 4). В этом вопросе я остановлюсь только на категории 2 "Покупки, которые необходимо совершить".

Я пытаюсь перенести все данные из рабочих таблиц ("Закупки") на панель инструментов в категории 2. Я пытаюсь использовать именованные диапазоны, чтобы сделать это, потому что диапазон каждой категории будет изменяться при добавлении / удалении элементов. Вы можете найти образец рабочей книги, над которой я работаю, - на excelforum.com.

Код ниже - это то, что я имею до сих пор. Это работает до некоторой степени, но диапазон ("PurchaseStart"), который составляет ячейку $A$8, начинается с A:1. Я не знаю, как выбрать только названный диапазон, который я ищу. Я добавил операторы "End #" в конце каждой строки, чтобы обозначить обрезку и надеюсь, что уловка превзойдет только выбор диапазона определенной категории.

Option Explicit

Sub purchPull()

Dim Dashboard As Worksheet
Dim Purchasing As Worksheet
Dim PM As Range, D As Range, Rng As Range
Dim purchName As Range

Set Purchasing = Worksheets("Purchasing")
Set Dashboard = Worksheets("Dashboard")


' Go through each Item in Purchasing and check to see if it's anywhere      within the named range "PurchaseStart"
' In this case it should be "A8:A9" - as there is nothing in the dasboard yet
For Each PM In Purchasing.Range(Purchasing.Cells(1, 1),     Purchasing.Cells(Purchasing.Rows.Count, 1).End(xlUp))
    With Dashboard.Range("PurchaseStart",   Dashboard.Cells(Dashboard.Rows.Count, 1))
    Set Rng = .Find(What:=PM.Offset(0, 1), _
        After:=.Cells(.Cells.Count), _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=False)
    If Not Rng Is Nothing Then
        ' Do nothing, as we don't want duplicates
    Else
        ' From the start of the named range, transfer data over - THIS IS THE PROBLEM AREA
        With Dashboard.Range("PurchaseStart", Dashboard.Cells(.Rows.Count, 1)).End(xlUp)
            .Offset(1, 1) = PM.Offset(0, 0) ' Order Number
            .Offset(1, 2) = PM.Offset(0, 1) ' SKU
            .Offset(1, 3) = PM.Offset(0, 3) ' Qty
            .Offset(1, 4) = PM.Offset(0, 4) ' Date
        End With
    End If
End With
Next

End Sub

Answer 1

Вы можете сделать что-то вроде: (Предполагается, что в начале каждого раздела данных есть некоторый заголовок, то есть "Необходимо сделать", а затем под этим заголовком находятся данные для этого раздела):

Sub findDataStartRow()
Dim f as Range, dataStartRange as Range

Set f = Columns(1).Find(what:="Need to be made", lookat:xlWhole)
If Not f is Nothing Then
    dataStartRange = Cells(f.row + 1, 1) 'Do stuff with this range... maybe insert rows below it to start data
Else: Msgbox("Not found")
    Exit Sub
End if
End Sub

Делайте подобное для каждого раздела. Таким образом, независимо от того, куда идет заголовок (и, следовательно, начало расположения данных), вы всегда будете иметь именованный диапазон местоположения прямо под заголовком. В качестве альтернативы, если вы хотите добавить данные в конец раздела, просто найдите заголовок для раздела ниже, где вы хотите, чтобы данные были, и установите dataStartRange = Cells(f.row - 1, 1) после изменения .Find правильно.

Answer 2

Я понял. Я думаю, что это довольно хороший способ решения проблемы, но если кто-то может придумать лучший способ, я бы хотел услышать это. Спасибо всем за помощь.

Option Explicit

Sub purchPull()

Dim Dashboard As Worksheet
Dim Purchasing As Worksheet
Dim PM As Range, D As Range, Rng As Range
Dim purchName As Range
Dim lastRow As Long
Dim firstRow As Long

Set Purchasing = Worksheets("Purchasing")
Set Dashboard = Worksheets("Dashboard")

' first row of named range "PurchaseStart"
firstRow = Dashboard.Range("PurchaseStart").Row +     Dashboard.Range("PurchaseStart").Rows.Count



' Go through each Item in Purchasing and check to see if it's anywhere within the named range "PurchaseStart"
With Purchasing
For Each PM In Purchasing.Range(Purchasing.Cells(2, 1), Purchasing.Cells(Purchasing.Rows.Count, 1).End(xlUp))
    With Dashboard.Range("PurchaseStart", Dashboard.Cells(Dashboard.Rows.Count, 1))
        Set Rng = .Find(What:=PM.Offset(0, 0), _
            After:=.Cells(.Cells.Count), _
            LookIn:=xlValues, _
            LookAt:=xlWhole, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False)
        If Not Rng Is Nothing Then
            ' Do nothing, as we don't want duplicates
        Else      
            ' Identify the last row within the named range "PurchaseStart"
            lastRow = Dashboard.Range("PurchaseStart").Cells(1, 1).End(xlDown).Row
            ' Transfer the data over
            With Dashboard.Cells(lastRow, 1).End(xlUp)
                .Offset(1, 0).EntireRow.Insert
                .Offset(1, 0) = PM.Offset(0, 0)  ' Order Number
                .Offset(1, 1) = PM.Offset(0, 1) ' SKU
                .Offset(1, 2) = PM.Offset(0, 2) ' Qty
                .Offset(1, 3) = PM.Offset(0, 3) ' Date
            End With
        End If
    End With
Next
End With

End Sub