Sub copyWhenCriteriaIsMet()
Dim shFrom as worksheet, shTo as worksheet
Dim rngReadCell as Range, rngRead as Range
Dim intWriteRow as integer
'Change shFrom to the sheet name we are reading and shTo to the sheet we are writing to
set shFrom = Sheets("Sheet1")
set shTo = Sheets("Sheet2")
'Change this to fit the range we are reading
set rngRead = shFrom.Range("GG1:GG5000")
'Set the initial row to which we are writing the found data
'Inside the For loop below we will increase this by one whenever we write a new line
intWriteRow = 1
'Now loop through each cell in the range using a "For" loop
For Each rngReadCell in rngRead.Cells
'Everything happening between "For" and "Next" is done over and over again for each cell
'We can reference the Cell that is being read as it will be automatically stored in
'variable "rngReadCell"
'Use an "IF" statement to test if the value in rngReadCell says "Passed with flying colors"
If rngReadCell.Value = "Passed with flying colors" 'note this is case sensitive here in VBA
'Everything happening between "If" and "End IF" only happens if that conditions is true
'Copy the contents of rngReadCell's Row (between Column A and GH) to the other sheet
'There are a few ways to reference this A:GH range, I'm going to use "RANGE()" and concatenate
'since that's the easier to understand than .offset().resize() or .Row().Range()
shFrom.Range("A" & rngReadCell.row & ":GH" & rngReadCell.row).copy Destination:=shTo.Range("A" & intWriteRow)
'Now that we wrote that line out, lets increment the intWriteRow variable
intWriteRow = intWriteRow + 1
End IF
'Nothing else to do here, so this will loop back to the top of the For loop and test the next
'rngReadCell.Value
Next rngReadRow
End Sub
1 回答
这是一个非常简单的VBA例程，但是当你第一次开始时，我总是很难理解这些东西 . 下面我有一个未经测试的子程序，可以让你在99％的路上 . 我提出了大量的意见来帮忙 .