Question

在编程时我完全无能为力，因此我在这里寻求帮助。

我在书中有几个工作表，每个工作表都有一个特定的库存项目和一个共同的库存项目，它们显示了这些项目的去向。见下面的例子：

常用表格

Date |Code  |Name      |Reason|Item 1|Item 2|Item 3|Item 4|
1-may|ABC001|John Smith|Call  |1     |      |2     |1     |
2-may|CAA002|Mary Jane |New   |      |2     |2     |      |

第1项

Date |Code  |Name      |Reason|Used|
1-may|ABC001|John Smith|Call  |1   |

我需要做的是每天填写主要商品单。即John将以1,3和4的项目输入表格，Mary将在第2和第3项中输入。

有办法吗？

提前致谢！

Answer 1

我已经过测试并且大部分都在使用，您可能需要进行一些编辑才能使工作表的名称与工作簿中的内容相符，我也不完全确定您是如何仅复制某些列的（下面的代码）将复制整行）

Sub ConsolidateX()

Dim ws As Worksheet, wsItem1 As Worksheet, wsItem2 As Worksheet   'set ws"Name" to the sheet names in your workbook, define all worksheets that you are going to copy to
Dim lrow As Long, rng As Range
Dim tdate As Date

tdate = Date

Set wsItem1 = ThisWorkbook.Sheets("Item 1")
Set wsItem2 = ThisWorkbook.Sheets("Item 2")   'make sure you set all of your worksheet names for all of the items you wish to copy for

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

With ActiveSheet
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    .AutoFilterMode = False
    .Range("A2:I" & lrow).AutoFilter Field:=1, Criteria1:="<" & tdate  'Leave this line in here to first filter for todays date (to prevent you from copying over old data
    .Range("A2:I" & lrow).AutoFilter Field:=3, Criteria1:="<>" 'change the field # to reflect what column you are checking to make sure is not blank
    .Range("A3:I" & lrow).SpecialCells(xlCellTypeVisible).EntireRow.Copy
    wsItem1.Range("A" & wsItem1.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
.AutoFilterMode = False
Application.CutCopyMode = False
.Range("A2:I" & lrow).AutoFilter Field:=1, Criteria1:="<" & tdate   
.Range("A2:I" & lrow).AutoFilter Field:=4, Criteria1:="<>"  'just continue to copy this repeated part of code down for as many Items as you are trying to filter for remembering to change the Autofilter Field # and copy location
.Range("A3:I" & lrow).SpecialCells(xlCellTypeVisible).EntireRow.Copy
wsItem2.Range("A" & wsItem2.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
.AutoFilterMode = False
Application.CutCopyMode = False
End With

With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With

End Sub

我使用空白工作簿和一些虚拟数据对此进行了测试，因此只要您更改所有名称和内容以适合您的工作簿，它就应该没问题。另外，请确保从主工作表中运行此宏，因为它只会应用过滤器并从当前工作表中进行复制。

抱歉，我不知道如何像你想要的那样复制这行，但这应该是一个很好的起点。

将数据从一个Excel工作表排序到其他几个

1 个答案: