VBAを使用して、特定の値が列に存在する場合、行からデータをコピーする方法は？

Question

私はレポート作成に役立つスプレッドシートに取り組んできましたが、私は最後の要素に困惑しています。基本的に、ワークシートの列Gに特定のテキスト文字列が含まれている場合、適切な行をそのシートの既存データの下にある別のワークシートにコピーしたいとします。

2時間のグーグルで私はさまざまなソリューションを試しましたが、私が望むことをするように構成することはできませんでした。現在、私は以下で働いている：

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まで）、値が「保留中」になっているかどうかを確認します。見つかったら、「保持されたデータ」ワークシートの行全体を次の空白行にコピーします。

注：SelectとActiveSheetは現在のActiveSheetに従って変更される可能性があるため、使用しない方がよいでしょう。代わりに、.Cellsと範囲の参照されたシートオブジェクトを使用する方が良いです。

コード

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

あなたは文字列（"Customer placed on hold"）に対してコラム "G" の値を確認したいので、あなたが列をループ避けたいです」列 "G"のみのセルをループしてループする

すべてのセルをループすることを避けることができます。 dはちょうど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 (i.e.: 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 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