VBA代码不彼此相邻的

Question

Project Master

在MS Excel中使用VBA列的有条件复制，我想在同一工作簿中上条件复印一些帮助工作表之间。根据所附的图片，我在工作表“Master”上有一个主项目清单。对于列I（缺陷）中的“是”的所有项目，我想复制列A（工程包发布日期），B（项目编号），E（城市）和H（合同值）到另一个工作表“缺陷”，在同一工作簿中。 您能否提供一个编码： a）折叠所有行，使“缺陷”工作表中没有空白行;和 b）保留所有行，如果“缺陷”列中有“否”，则“主”工作表中的相关行将被复制为“缺陷”工作表中的空行，如果可能的话，则为 。 请帮我编写代码 - 我对宏有非常基本的了解，并且学习如何编写代码。 谢谢&关心，CK

Answer 1

试试这个让你开始。此外，在将来，请张贴您拥有的代码，收到的错误或您遇到的具体问题，而不是要求代码解决问题。还有很多其他的海报，如果你没有表明自己已经提出了一些解决方案，他们会简单地投票给你，或者删除你的帖子。

Sub CopyValues() 

'Declare variables 
'Declare sheet variables 
Dim Masterws as Worksheet 
Dim Defectws as worksheet 

'Declare counter variables 
Dim I as Integer 
Dim n as Integer 

'Set value of sheet variables 
Set Masterws=ThisWorkbook.Sheets("Master") 
Set Defectws=ThisWorkbook.Sheets("Defects") 

'Set value of counter to track first available row on Defects sheet 
n=1 

'Start a For loop to check each row on Master sheet, starting with row 2 
For I = 2 to WorksheetFunction.CountA(Masterws.Columns.EntireColumn(1)) 

    'If the cells in row I, column I have a value of, "Yes," then execute some code. If not, continue on. 
    If Cells(I, "I").value= "Yes" Then 

     'Set the value of cells in row n of the Defects sheet to the corresponding values of row I in the Master sheet. If n is replaced with I, then the value of cells in row I on Defects will be set to the values of Row I on Master, leaving blank rows where no, "Yes," was found because no copying took place. 
     Defectws.Cells(n,"A").Value=Masterws.cells(I,"A") 
     Defectws.Cells(n,"B").Value=Masterws.cells(I,"B") 
     Defectws.Cells(n,"C").Value=Masterws.cells(I,"E") 
     Defectws.Cells(n,"D").Value=Masterws.cells(I,"H") 

     'Add 1 to the n counter. The next time a row is found in the Master sheet with, "Yes," it will be written to the next available row down on the Defects sheet. 
     n=n+1 

    End If 

'End of the For loop. Move on to the next row on Master sheet 
Next 

End Sub 

Answer 2

@ asp8811感谢您的代码，它运作良好。很抱歉，我没有提前写过我已经有的东西 - 我是Stack Overflow的新手，并且新编码 - 将始终以我的代码向前发展。以下是我目前为止的内容 - 将您的代码和答案与我之前询问的另一个问题结合起来。你的代码运行良好，给我选择我选择的列的能力，不像我在下面 - 它打印A和H之间的所有列。我的挑战是，如果存在的话，我想保留行（作为空白行） Defects列中的“No” - 这是我在下面的内容，但我也想报告那些不相邻的列，并且能够选择像你一样的列。

Sub CopyValues() 

Dim Masterws As Worksheet 
Dim Defectws As Worksheet 
Dim I As Integer 
Dim n As Integer 

Set Masterws = ThisWorkbook.Sheets("Master") 
Set Defectws = ThisWorkbook.Sheets("Defects") 

n = 1 

For I = 2 To WorksheetFunction.CountA(Masterws.Columns.EntireColumn(1)) 

    If (Masterws.Range("J" & I) = "Yes") Then 
    Masterws.Range("A" & I & ":H" & I).Copy Destination:=Worksheets("Defects").Range("A" & I) 

    n = n + 1 
    End If 

Next 
End Sub