web-dev-qa-db-ja.com

基準を満たすVBAの行を別のシートにコピーする

私はVBAを初めて使用しています...この行の最初のセルがXを示している場合、Sheet2からSheet1に行をコピーし、この基準を満たすすべての行に対してコピーします。 If条件にエラーがあります...それを修正する方法がわかりません。

Sub LastRowInOneColumn()
'Find the last used row in a Column: column A in this example
    Worksheets("Sheet2").Activate
    Dim LastRow As Long
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    MsgBox (LastRow)
    For i = 1 To LastRow
    If Worksheet.Cells(i, 1).Value = "X" Then
    ActiveSheet.Row.Value.Copy _
    Destination:=Hoja1
    End If
    Next i
 End Sub
excelexcel-vbacopy-pastevba
6
Anca

ワークシートを指定する必要があります。行を変更

If Worksheet.Cells(i, 1).Value = "X" Then

に

If Worksheets("Sheet2").Cells(i, 1).Value = "X" Then

UPD：

次のコードを使用してみてください（ただし、最善のアプローチではありません。@ SiddharthRoutが示唆したように、 Autofilter の使用を検討してください）。

Sub LastRowInOneColumn()
   Dim LastRow As Long
   Dim i As Long, j As Long

   'Find the last used row in a Column: column A in this example
   With Worksheets("Sheet2")
      LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   End With

   MsgBox (LastRow)
   'first row number where you need to paste values in Sheet1'
   With Worksheets("Sheet1")
      j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
   End With 

   For i = 1 To LastRow
       With Worksheets("Sheet2")
           If .Cells(i, 1).Value = "X" Then
               .Rows(i).Copy Destination:=Worksheets("Sheet1").Range("A" & j)
               j = j + 1
           End If
       End With
   Next i
End Sub
10
Dmitry Pavliv

私自身のコードに対する以前の回答をフォーマットした後、AutoFilterを介して返された値を別のシートに貼り付けようとすると、必要なすべてのデータをコピーする効率的な方法を見つけました。

With .Range("A1:A" & LastRow)
    .Autofilter Field:=1, Criteria1:="=*" & strSearch & "*"
    .Offset(1,0).SpecialCells(xlCellTypeVisible).Cells.Copy
    Sheets("Sheet2").activate
    DestinationRange.PasteSpecial
End With

このブロックでは、AutoFilterはstrSearchの値を含むすべての行を検索し、他のすべての値を除外します。次に、セルをコピーし（ヘッダーがある場合はオフセットを使用）、宛先シートを開き、宛先シートの指定された範囲に値を貼り付けます。

0
Munkeeface