Question

我正在尝试找到一种解决方案，了解如何在满足特定条件时将行中的行复制到另一个工作表中。我已经尝试过这里发布的其他宏/解决方案但没有用。

我想要复制到新工作表中的数据是GG行，文本是“通过飞行颜色传递”。它位于名为SchoolEast

的工作表中

我希望在数据集中GG列的单元格中找到此短语时，将整行从A复制到GH。目标表称为PassedFC。

很想得到一些帮助。如果您需要更多信息，请与我们联系。

Answer 1

这是一个非常简单的VBA例程，但是当你第一次开始时，我总是很难理解这些东西。下面我有一个未经测试的子程序，可以让你在99％的路上。我发表了大量的意见来帮忙。

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 个答案: