如何使用VBA在列中存在特定值时从行中复制数据？

我一直在制作一个电子表格来帮助进行报告，而且我最终陷入了困境。 从本质上讲，如果工作表的G列包含特定的文本string，我想将相应的行复制到另一个工作表中该表中的现有数据下。

经过两个小时的谷歌search，我尝试了各种解决scheme，但一直没有能够configuration一个做我想做的。 目前我正在与以下工作：

Dim x As Integer Dim Thisvalue As String Dim NextRow As Range Sheets("Week 4").Select ' Find the last row of data FinalRow = Cells(Rows.Count, 1).End(xlUp).Row ' Loop through each row For x = 2 To FinalRow ' Decide if to copy based on column D Thisvalue = Cells(x, 7).Value If Thisvalue = "Customer placed on hold" Then Cells(x, 1).Resize(1, 33).Copy Sheets("Retained data").Select NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(NextRow, 1).Select ActiveSheet.Paste Sheets("Week 4").Select End If Next x End Sub 

然而，我认为我走错了路，而且我已经完全忘记了VBA，所以我基本上是从头开始的，据我所知。 任何帮助将不胜感激！

Answer 1

下面的代码将遍历G列中的所有单元格（直到FinalRow ），并检查“客户处于保留状态”的值。 当它find时，它将整个行复制到“保留数据”工作表中的下一个可用行。

注意：最好避免使用Select和ActiveSheet因为它们可能会根据当前的ActiveSheet改变。 相反，最好使用引用的Sheet对象， .Cells和Ranges。

码

 Option Explicit Sub CopyRow() Dim x As Long Dim Thisvalue As String Dim NextRow As Long Dim FinalRow As Long With Sheets("Week 4") ' Find the last row of data in Column A FinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row ' Loop through each row For x = 2 To FinalRow ' Decide if to copy based on column G If .Cells(x, 7).Value = "Customer placed on hold" Then ' Find the last row of data NextRow = Sheets("Retained data").Cells(Sheets("Retained data").Rows.Count, 1).End(xlUp).Row ' copy > paste in 1 line .Cells(x, 7).EntireRow.Copy Sheets("Retained data").Range("A" & NextRow + 1) End If Next x End With End Sub 

Answer 2

试试这个：

 Sub Makro2() Dim x As Integer Dim Thisvalue As String Sheets("Week 4").Select ' Find the last row of data FinalRow = Cells(Rows.Count, 1).End(xlUp).Row ' Loop through each row For x = 2 To FinalRow ' Decide if to copy based on column D Thisvalue = Cells(x, 7).Value If Thisvalue = "Customer placed on hold" Then Range(Cells(x, 1), Cells(x, 33)).Copy With Sheets("Retained data") .Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial xlPasteAll End With End If Next x End Sub 

Answer 3

既然你想检查一个string的列“G”值（ "Customer placed on hold" ），那么你想避免循环通过列“A”单元格，并通过列“G”的“string”单元循环

那么你可以避免循环遍历所有的单元格，只需Find()想要的：

 Sub CopyRow() Dim firstAddress As String Dim f As Range With Worksheets("Week 4") '<--| reference your relevant worksheet With .Range("G2", .Cells(.Rows.COUNT, "G").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues) '<--| loop through its column G "string" values only Set f = .Find(what:="Customer placed on hold", lookat:=xlWhole, LookIn:=xlValues, after:=.Areas(.Areas.COUNT).Cells(.Areas(.Areas.COUNT).COUNT)) '<--| search for wanted string in referenced range, starting from the cell after its last cell (ie: the first cell) If Not f Is Nothing Then '<--| if found firstAddress = f.Address '<--| store its address to stop 'Find()' loop at its wrapping back to the first found cell Do With Worksheets("Retained data") '<--| reference target sheet f.EntireRow.Copy .Cells(.Rows.COUNT, 1).End(xlUp).Offset(1) '<--| copy found cell entire row into last referenced worksheet first not empty cell End With Set f = .FindNext(f) '<--| find next cell matching wanted value Loop While f.Address <> firstAddress '<--| exit loop when it wraps back to first found cell End If End With End With End Sub 

如果您的列“G”数据超出列“A”数据的实际范围，并且您有兴趣将范围限制在后者，那么您只需更改：

 With .Range("G2", .Cells(.Rows.COUNT, "G").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues) '<--| loop through its column G "string" values only 

至

 With Intersect(.Range("A2", .Cells(.Rows.COUNT, "A").End(xlUp)).EntireRow, .Range("G2", .Cells(.Rows.COUNT, "G").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues)) '<--| loop through its column G "string" values only down to its column "A" last not empty row