传送专用数据从一个工作表到另一个报告

Question

我有一个Excel表格来管理客户的订单。请在下面找到相同的图片。

现在，为了计划物料的生产，我正在手动复制和粘贴订单为“按计划发货”的数据。按照下图报告工作表。

有人可以建议我使用特定的VBA代码或公式，以将数据自动排列到“按计划发货”报告表中吗？

Answer 1

这不一定是一个恕我直言的StackOverflow问题，它是一个“我如何学习VBA”问题-因为您并不是在询问需要解决的具体问题。无论如何，我写了一些代码，这些代码应该可以完成您在帖子中所描述的。

请注意，它基本上执行0次错误检查，并且宏代码的执行是不可逆的，因此请在开始使用之前存储数据的备份文件：

Sub ShipInPlan()
        Dim OrderNum As Long
        Dim StartNum, EndNum As Long
        Dim NumFound As Boolean
        Dim Ws As Worksheet

        'Create input box, so you the user can design which number to ship
        OrderNum = InputBox("For which order Number do you want to create the report?")

        'Find first row of order
        NumFound = False
        Counter = 1

        Do While NumFound = False
            If Sheets("Booking").Cells(Counter, 1).Value <> OrderNum Then
                Counter = Counter + 1
            Else
                NumFound = True
            End If

            If Counter > 500 Then
                NumFound = True
            End If
        Loop

        StartNum = Counter

        'Find last row of order
        Counter = Counter + 1
        NumFound = False

        Do While NumFound = False
            If Len(Sheets("Booking").Cells(Counter, 1).Value) = 0 Then
                Counter = Counter + 1
            Else
                NumFound = True
            End If

            If Counter - NumFound > 500 Then
                NumFound = True
            End If
        Loop

        EndNum = Counter - 2

        'Delete any report sheet that exists then create Sheet
        On Error Resume Next
        Application.DisplayAlerts = False
        Worksheets("Report").Delete
        Set Ws = ThisWorkbook.Sheets.Add(After:= _
                 ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        Ws.Name = "Report"
        Application.DisplayAlerts = True
        On Error GoTo 0

        'Copy contents and go to report sheet
        Sheets("Report").Range("A1:I1").Value = Sheets("Booking").Range("A1:I1").Value
        Sheets("Report").Range(Sheets("Report").Cells(2, 1), Sheets("Report").Cells(1 + EndNum - StartNum, 10)) = Sheets("Booking").Range(Sheets("Booking").Cells(StartNum, 1), Sheets("Booking").Cells(EndNum, 10)).Value
        Sheets("Report").Activate

End Sub