私が持っているテーブルの列を検索し、その列に数値を持つそのテーブルの行のみをコピーしてスプレッドシートの次のシートに貼り付けるマクロをまとめました。これは、ボタンが押されると発生します。私のコードは次のとおりです。
Sub Button1_Click()
Dim r As Long, endRow As Long, pasteRowIndex As Long
Set WS = Worksheets("Sheet1")
With WS
Set LastCell = .Cells(.Rows.Count, "C").End(xlUp)
LastCellRowNumber = LastCell.Row
End With
'endRow = 20 of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1
For r = 2 To LastCellRowNumber 'Loop through sheet1 and search for your criteria
If IsNumeric(Cells(r, Columns("E").Column).Value) And Not IsEmpty(Cells(r, Columns("E").Column).Value) Then 'Found
'Copy the current row
Rows(r).Select
Selection.Copy
'Switch to the sheet where you want to paste it & paste
Sheets("Sheet2").Select
Rows(pasteRowIndex).Select
ActiveSheet.Paste
'Next time you find a match, it will be pasted in a new row
pasteRowIndex = pasteRowIndex + 1
'Switch back to your table & continue to search for your criteria
Sheets("Sheet1").Select
End If
Next r
End Sub
これは機能しますが、私の問題は、行を数式でコピーすることです(コピーすると使用できなくなります)。そのため、値のみをコピーするには、何らかの特殊な貼り付けが必要でした。私はこれを試しましたが、エラーが発生し続けるか、同じように機能しません..誰かが私のためにそれをチェックして、正しい方向に私を向けることができますか?
Sub Button1_Click()
Dim r As Long, endRow As Long, pasteRowIndex As Long, Location As Long
Set WS = Worksheets("Sheet1")
With WS
Set LastCell = .Cells(.Rows.Count, "C").End(xlUp)
LastCellRowNumber = LastCell.Row
End With
pasteRowIndex = 1
For r = 2 To LastCellRowNumber 'Loop through sheet1 and search for your criteria
If IsNumeric(Cells(r, Columns("E").Column).Value) And Not IsEmpty(Cells(r, Columns("E").Column).Value) Then 'Found
Location = 1
'Copy the current row
Rows(r).Select
Selection.Copy
'Switch to the sheet where you want to paste it & paste
Sheets("Sheet2").Select
Rows(pasteRowIndex).Select
ActiveSheet.Range(Cells(Location, 1)).PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Next time you find a match, it will be pasted in a new row
pasteRowIndex = pasteRowIndex + 1
Location = Location + 1
'Switch back to your table & continue to search for your criteria
Sheets("Sheet1").Select
End If
Next r
End Sub
どうもありがとう!