我有多个复制数组和3个不同的粘贴数组。我想从新工作簿中复制托盘类型、SKU和相应的案例(基于为负的案例),并将其粘贴到当前工作簿中。然后,我想将该信息与相应的信息一起粘贴到当前工作簿中。我想我有复制信息的代码。但是它没有将任何信息粘贴到当前工作簿。
Sub buildPlan()
'
' buildPlan Macro
'
Dim wb As Workbook
Dim colValsF, colValsE, colValsB As Collection
Dim v, arr, c, d, e As Range
Dim nwb As Workbook, wsAPP As Worksheet, wsDNDR As Worksheet
Set wb = Application.ActiveWorkbook 'ThisWorkbook?
Set wsAPP = wb.Worksheets("Arils Pack Plan ") 'trailing space?
'Opening Recent ATS report
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
.AllowMultiSelect = False
.Show
Application.Workbooks.Open .SelectedItems(1)
Set nwb = Application.ActiveWorkbook
End With
Set wsDNDR = nwb.Worksheets("DAILY NEED (DR)")
Set colValsE = New Collection
Set colValsF = New Collection
Set colValsB = New Collection
'Collect Pallet----------------------------------------------------------------------------------------------------------------------------------------------
Set d = wsDNDR.Range("E5:E14,E15:E25").Cells
For Each c In wsDNDR.Range("Q5:Q14,T5:T14,Q15:Q25,T15:T25").Cells
v = c.Value
If v < 0 Then colValsE.Add d
Next c
arr = CollectionToArray(colValsE) 'transfer the collection values to an array
If Not IsEmpty(arr) Then
wsAPP.Range("E7").Resize(UBound(arr, 1), 1) = arr 'place the array on the sheet
End If
'Collect SKU --------------------------------------------------------------------------------------------------------------------------------------------------
Set e = wsDNDR.Range("B5:B14,B15:B25").Cells
For Each c In wsDNDR.Range("Q5:Q14,T5:T14,Q15:Q25,T15:T25").Cells
v = c.Value
If v < 0 Then colValsB.Add e
Next c
arr = CollectionToArray(colValsB) 'transfer the collection values to an array
If Not IsEmpty(arr) Then
wsAPP.Range("B7").Resize(UBound(arr, 1), 1) = arr 'place the array on the sheet
End If
'collect all of the negative values----------------------------------------------------------------------------------------------------------------------------
For Each c In wsDNDR.Range("Q5:Q14,T5:T14,Q15:Q25,T15:T25").Cells
v = c.Value
If v < 0 Then colValsF.Add v
Next c
arr = CollectionToArray(colValsF) 'transfer the collection values to an array
If Not IsEmpty(arr) Then
wsAPP.Range("F7").Resize(UBound(arr, 1), 1) = arr 'place the array on the sheet
End If
End Sub
1条答案
按热度按时间irlmq6kh1#
现在我明白你在做什么了有一个简单得多的方法:遍历数据行并依次处理每个数据行,而不是逐列处理。