Question

我编写了一些代码，用于为列表中的每个项目分配基于行＃的代码。我想要做的是从每行中选择与所选代码对应的所有信息，然后将其粘贴到另一个工作簿。我遇到了一些麻烦。这是代码：

Sub LSHP_Distribute()

Dim wbLSHP As Workbook
Dim wsLSHP As Worksheet
Dim CodeRange As Range
Dim FirstRow As Long
Dim LastRow As Long

Dim wbTEST As Workbook

Set wbLSHP = ActiveWorkbook
Set wsLSHP = wbLSHP.Sheets("Sheet1")

'Generate codes for newly added items
 Application.ScreenUpdating = False                                             
'Turn off screen updating

With wsLSHP
    FirstRow = .Range("F3").End(xlDown).Row + 1
    LastRow = .Range("B6", .Range("B6").End(xlDown)).Rows.Count + 5
    Set CodeRange = .Range("$F$" & FirstRow, "$F$" & LastRow)
End With

For Each cell In CodeRange
    If cell = "" Then
        If cell.Row Mod 3 = 0 Then
            cell.Value = "1"
        ElseIf cell.Row Mod 3 = 1 Then
            cell.Value = "2"
        ElseIf cell.Row Mod 3 = 2 Then
            cell.Value = "3"
        Else
        End If
    End If
Next cell

'Open Spreadsheets to Distribute Items
Dim PasteRow As Long
Dim i As Integer
Set wbTEST = Workbooks.Open(Filename:="V:\Test.xlsx")

PasteRow = wbTEST.Sheets("Sheet1").Range("B6").End(xlDown).Row + 1

以下是我遇到问题的地方

wbLSHP.Activate
For Each cell In CodeRange
    If cell = "1" Then
        Range(ActiveCell.Offset(0, -5), ActiveCell.Offset(0, 20)).Select
        Selection.Copy
        wbTEST.Sheets("Sheet1").Cells(PasteRow, 1).PasteSpecial xlPasteValues
        PasteRow = PasteRow + 1
    Else
    End If
Next cell

End Sub

第一个问题是For循环没有在“CodeRange”中复制正确的范围，第二个问题是它只在我获得自动化错误之前复制一次。如果您有任何问题或者知道编写此代码的更有效方法，请告诉我。

非常感谢您的时间！

Answer 1

您的范围定义为从F3开始到BSomething结束，但您只将代码存储到CodeRange。

Set CodeRange = .Range("$F$" & FirstRow, "$F$" & LastRow)

尝试使用：

Set CodeRange = .Range("$B$" & FirstRow, "$F$" & LastRow)

我建议使用而不是复制和粘贴，将值赋给变量并将变量的值放在wbTEST上。

将基于条件的一个工作表中的值复制到另一个工作簿

1 个答案: