我正在尝试创建一个粘贴循环,并希望只要列中的值为负值,循环就会继续,并将其粘贴到用户将选择的另一个工作簿中。此外,我需要先粘贴一个区域,然后再粘贴另一个区域。在新工作簿中,我需要在完成4盎司循环后开始向下粘贴一个单元格,以便开始8盎司循环。
Sub Absolute_Value()
' Absolute_Value Macro
' Defining Terms
Dim sht As Worksheet
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim sht3 As Worksheet
Dim nwbsht1 As Worksheet
Dim nwbsht2 As Worksheet
Dim nwbsht3 As Worksheet
Dim nwbsht4 As Worksheet
Dim nwbsht5 As Worksheet
Dim nwbsht6 As Worksheet
Dim nwbsht7 As Worksheet
Dim nwbsht8 As Worksheet
Dim rngToAbs As Range
Dim LastRow As Long
Dim LastRW As Long
Dim LastRW1 As Long
Dim LastRW2 As Long
Dim LastRW3 As Long
Dim LastRW4 As Long
Dim LastRW5 As Long
Dim LastRW6 As Long
Dim LastRW7 As Long
Dim LastRW8 As Long
Dim LastRW9 As Long
Dim LastRW10 As Long
Dim c As Range
Dim wb As Workbook
Dim nwb As Workbook
Dim i As Range
Dim OnHand As Range
Dim OnHand2 As Range
Dim OnHand1 As Range
Dim Pallet As Range
Dim PalletType As Range
Dim Item As Range
Dim Item2 As Range
Dim UnitQty As Range
'Setting ranges for PackPlan workbook
Set wb = Application.ActiveWorkbook
Set sht = wb.Sheets("Arils Pack Plan ")
LastRow = sht.Cells(sht.Rows.Count, "F").End(xlUp).Row
Set rngToAbs = sht.Range("F7:F" & LastRow)
Set wb = Application.ActiveWorkbook
Set sht1 = wb.Sheets("Arils Pack Plan ")
LastRW5 = sht1.Cells(sht1.Rows.Count, "B").End(xlUp).Row
Set Item = sht1.Range("B7:B" & LastRW5)
Set wb = Application.ActiveWorkbook
Set sht2 = wb.Sheets("Arils Pack Plan ")
LastRW4 = sht2.Cells(sht2.Rows.Count, "E").End(xlUp).Row
Set PalletType = sht2.Range("E7:E" & LastRW4)
'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
'Setting Ranges for Daily Need Worksheet
'4oz Range Setting
Set nwb = Application.ActiveWorkbook
Set nwbsht1 = nwb.Sheets("DAILY NEED (DR)")
LastRW = nwbsht1.Cells(nwbsht1.Rows.Count, "Q").End(xlUp).Row
Set OnHand = nwbsht1.Range("Q5:Q14" & LastRW)
Set nwb = Application.ActiveWorkbook
Set nwbsht2 = nwb.Sheets("DAILY NEED (DR)")
LastRW6 = nwbsht2.Cells(nwbsht2.Rows.Count, "E").End(xlUp).Row
Set Pallet = nwbsht2.Range("E5:E14" & LastRW6)
Set nwb = Application.ActiveWorkbook
Set nwbsht3 = nwb.Sheets("DAILY NEED (DR)")
LastRW1 = nwbsht3.Cells(nwbsht3.Rows.Count, "T").End(xlUp).Row
Set OnHand1 = nwbsht3.Range("T5:T14" & LastRW1)
Set nwb = Application.ActiveWorkbook
Set nwbsht4 = nwb.Sheets("DAILY NEED (DR)")
LastRW2 = nwbsht4.Cells(nwbsht4.Rows.Count, "Y").End(xlUp).Row
Set OnHand2 = nwbsht4.Range("Y5:Y14" & LastRW2)
'8oz Range Setting
Set nwb = Application.ActiveWorkbook
Set nwbsht5 = nwb.Sheets("DAILY NEED (DR)")
LastRW7 = nwbsht5.Cells(nwbsht5.Rows.Count, "Q").End(xlUp).Row
Set OnHand = nwbsht5.Range("Q15:Q25" & LastRW7)
Set nwb = Application.ActiveWorkbook
Set nwbsht6 = nwb.Sheets("DAILY NEED (DR)")
LastRW8 = nwbsht6.Cells(nwbsht6.Rows.Count, "E").End(xlUp).Row
Set Pallet = nwbsht6.Range("E15:E25" & LastRW8)
Set nwb = Application.ActiveWorkbook
Set nwbsht7 = nwb.Sheets("DAILY NEED (DR)")
LastRW9 = nwbsht7.Cells(nwbsht7.Rows.Count, "T").End(xlUp).Row
Set OnHand1 = nwbsht7.Range("T15:T25" & LastRW9)
Set nwb = Application.ActiveWorkbook
Set nwbsht8 = nwb.Sheets("DAILY NEED (DR)")
LastRW10 = nwbsht8.Cells(nwbsht8.Rows.Count, "Y").End(xlUp).Row
Set OnHand2 = nwbsht8.Range("Y15:Y25" & LastRW10)
'Copy and Paste Loop
nwb.Activate
Do While i < OnHand
For i = 1 to
If OnHand.Value < 0 Then
nwb.Activate
OnHand.Select
wb.Activate
Selection.Copy
rngToAbs.PasteSpecial Paste:=xlPasteValues
End If
Next i
' Absolute_Value Macro
For Each c In rngToAbs
c.Value = Abs(c.Value)
If rngToAbs.Cells(c, 1).Value <> "" Then Exit For
Next c
End Sub
2条答案
按热度按时间k97glaaz1#
作为对我关于为同一对象设置多个变量的评论的澄清...
而不是这个:
你可以这样做:
不过,通常情况下,您不希望使用不同的“最后一行”值从同一个表中阅读列--选择一列来查找最后一行,然后将其用于表中的所有列。
beq87vna2#
我想这就是你试图用for循环来完成的事情: