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

问题描述：

我已经编写了一些代码，它将基于行＃的代码中的每个项分配给一个代码。我想从那里做的是从每行中选择一个与所选代码相对应的所有信息，然后将其粘贴到另一个工作簿中。我一直有一些麻烦。下面的代码：在那里我遇到的问题将基于条件的值从一张表复制到另一个工作簿

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

第一个问题是对于循环不复制正确的范围内“CodeRange”

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

下面是，第二个问题是，它在出现自动化错误之前只复制一次。让我知道你是否有任何问题，或知道更有效的方式来编写这段代码。

非常感谢您的时间！

为什么不将所有项目移动到新的工作簿，然后运行代码以删除不必要的项目？应该节省一些心痛 – Cyril

在你最后一个循环导致你的问题，你突然提到'ActiveCell'，但它不清楚这是什么。它应该是“细胞”吗？其次，在复制之后，您将'PasteRow'增加1，但您复制的范围超过一行。 – SJR

答

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

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

尝试使用：

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

我建议，而不是复制和粘贴，赋值给一个变量，把变量的值上wbTEST。

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

相关推荐