根据条件将值从一个工作表复制到另一个工作簿

I've written some code that assigns each item in a list a code based on row #. What I want to do from there is choose a copy all information from each row that corresponds with a chosen code, then paste it to another workbook. I've been having some trouble. Here's the code:

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

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

Below is where I'm having the problem

以下是我遇到问题的地方

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

First problem is the For loop isn't copying the correct range in "CodeRange", the second problem is it only copies once before I get an Automation Error. Let me know if you have any questions, or know of a more efficient way to write this code.

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

Thanks so much for your time!

非常感谢你的时间！

1 个解决方案

#1

Your range is defined to Start in F3 and end in BSomething, but you store to CodeRange only the F column.

您的范围定义为在F3中开始并在BSomething中结束，但您只在F列中存储到CodeRange。

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

Try using:

尝试使用：

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

I suggest instead of Copy and Paste, assign the value to a variable and put the value of the variable on wbTEST.

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

#1