我列B中的问题列表及其在C列中的相关状态。 我想只复制那些状态为＆＃34;准备测试＆＃34;，＆＃34;内置产品＆＃34;，＆＃34;进行中＆＃34;或者＆＃34;等待CAB批准＆＃34;到D列，不希望它们之间有空白单元格。
我稍微修改了本主题中的代码，但无法使其适用于四种不同的状态类型（我尝试添加ElseIf语句，但似乎不起作用）：
Copy all cells with certain value into another column skipping blanks
Sub RangeCopyPaste()
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1
'--> Loop through each cell in column C
'--> Add each cell in column B with value "Ready for Testing" in column B to
NewRange
For Each cell In Worksheets("OverviewTest").Range("C6:C56")
If cell.Value = "Ready for Testing" Then
If MyCount = 1 Then Set NewRange = cell.Offset(0, -1)
Set NewRange = Application.Union(NewRange, cell.Offset(0, -1))
MyCount = MyCount + 1
End If
Next cell
'--> Copy NewRange from inactive sheet into active sheet
NewRange.Copy Destination:=ActiveSheet.Range("D6")
End Sub
提前感谢您对此提供任何帮助，我对Excel VBA非常陌生。
更新02/06/2017
我创建了一个简化版本的文件，用于演示我想要实现的目标。我的原始文件有很多选项卡，每个选项卡有更多列和数百行。 （道歉，它不允许我添加多个图像，所以我不得不上传一个大图像）
Sheet2 - 包含有关作业的所有详细信息
Sheet1 - 我正在寻找仅显示活动作业的Overview选项卡。列A包含指向工作表2中更改的超链接。列F具有条件格式，如果复制了单元格，则将其删除，因此我使用了VLOOKUP
当我从Tom或Scott运行原始脚本时（带有D和E列的单独循环），正确复制了详细信息，但不会复制超链接。 当我运行新脚本时，E列被正确复制，但D列和F列由于某种原因没有。 我认为原始脚本适用于E列，但对于D列，是否有保留超链接的方法？ https://i.stack.imgur.com/clR2b.jpg
原始剧本
Sub RangeCopyPaste()
Dim cell As Range
Dim NewChangeRange As Range
Dim NewDetailRange As Range
Set NewChangeRange = Range("D6") 'Set the first destination cell
For Each cell In Worksheets("Sheet1").Range("C6:C14") 'Loop through your Status column
Select Case cell.Value 'Select Case is an alternative to writing multiple If, ElseIf statements, particularly if you want it to run the same code when it is true.
Case "Ready for Testing", "Build in Prod", "In Progress", "Awaiting CAB Approval" 'Specify all the values which would consitute a "True" result
NewChangeRange.Value = cell.Offset(0, -2).Value 'In the destination cell, take the cell value 1 column to the left of the cell which contained the required status
Set NewChangeRange = NewChangeRange.Offset(1, 0) 'Setup the new destination cell ready for the next "True" result
End Select
Next cell
Set NewDetailRange = Range("E6") 'Set the first destination cell
For Each cell In Worksheets("Sheet1").Range("C6:C14") 'Loop through your Status column
Select Case cell.Value 'Select Case is an alternative to writing multiple If, ElseIf statements, particularly if you want it to run the same code when it is true.
Case "Ready for Testing", "Build in Prod", "In Progress", "Awaiting CAB Approval" 'Specify all the values which would consitute a "True" result
NewDetailRange.Value = cell.Offset(0, -1).Value 'In the destination cell, take the cell value 1 column to the left of the cell which contained the required status
Set NewDetailRange = NewDetailRange.Offset(1, 0) 'Setup the new destination cell ready for the next "True" result
End Select
Next cell
End Sub
新脚本
Sub RangeCopyPaste()
Dim cell As Range
Dim NewChangeRange As Range
Dim NewDetailRange As Range
Set NewChangeRange = Range("D6") 'Set the first destination cell
For Each cell In Worksheets("Sheet1").Range("C6:C14") 'Loop through your Status column
Select Case cell.Value 'Select Case is an alternative to writing multiple If, ElseIf statements, particularly if you want it to run the same code when it is true.
Case "Ready for Testing", "Build in Prod", "In Progress", "Awaiting CAB Approval" 'Specify all the values which would consitute a "True" result
Range(cell.Offset(0, -2), cell.Offset(0, -2)).Copy NewChangeRange
Set NewChangeRange = NewChangeRange.Offset(1, 0) 'Setup the new destination cell ready for the next "True" result
End Select
Next cell
Set NewDetailRange = Range("E6") 'Set the first destination cell
For Each cell In Worksheets("Sheet1").Range("C6:C14") 'Loop through your Status column
Select Case cell.Value 'Select Case is an alternative to writing multiple If, ElseIf statements, particularly if you want it to run the same code when it is true.
Case "Ready for Testing", "Build in Prod", "In Progress", "Awaiting CAB Approval" 'Specify all the values which would consitute a "True" result
NewDetailRange.Value = cell.Offset(0, -1).Value 'In the destination cell, take the cell value 1 column to the left of the cell which contained the required status
Set NewDetailRange = NewDetailRange.Offset(1, 0) 'Setup the new destination cell ready for the next "True" result
End Select
Next cell
End Sub
答案 0 :(得分：0)
在此处利用Case声明。见下文。
Sub RangeCopyPaste()
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1
'--> Loop through each cell in column C
'--> Add each cell in column B with value "Ready for Testing" in column B to
For Each cell In Worksheets("OverviewTest").Range("C6:C56")
Select Case cell.Value
Case is = "Ready for Testing", "Build in Prod", "In Progress", "Awaiting CAB Approval"
If MyCount = 1 Then
Set NewRange = cell.Offset(0, -1)
Else
Set NewRange = Application.Union(NewRange, cell.Offset(0, -1))
End If
MyCount = MyCount + 1
End Select
Next cell
'--> Copy NewRange from inactive sheet into active sheet
NewRange.Copy Destination:=ActiveSheet.Range("D6")
End Sub
答案 1 :(得分：0)
请尝试使用以下代码解决您的问题;
Sub RangeCopyPaste()
Dim cell As Range
Dim NewRange As Range
Set NewRange = Range("D1") 'Set the first destination cell
For Each cell In Worksheets("Sheet1").Range("C1:C16") 'Loop through your Status column
Select Case cell.Value 'Select Case is an alternative to writing multiple If, ElseIf statements, particularly if you want it to run the same code when it is true.
Case "Ready for testing", "Build in Prod", "In Progress", "Awaiting CAB Approval" 'Specify all the values which would consitute a "True" result
NewRange.Formula = Range(cell.Offset(0, -2), cell.Offset(0, -2)).Formula 'Copies the formula from Column A
NewRange.Offset(0, 1).Value = Range(cell.Offset(0, -1), cell.Offset(0, -1)).Value ' Copies the value from Column B
NewRange.Offset(0, 2).Value = Range(cell).Formula ' Copies the formula from Column C
Set NewRange = NewRange.Offset(1, 0) 'Setup the new destination cell ready for the next "True" result
End Select
Next cell
End Sub