行に「true」が検出された場合に特定の列をコピーして貼り付ける必要がある小さなプロジェクトに取り組んでいます。これらの選択した列を別のシートに貼り付けようとしていますが、数式ではなく値のみを貼り付けたいと思います。
これは私がこれまでに持っているものであり、貼り付けの特殊機能でエラーが発生します。助けてください。
' CopyIfTrue()
Dim Col As Range, Cell As Excel.Range, RowCount As Integer
Dim nysheet As Worksheet
Set nysheet = Sheets.Add()
nysheet.Name = "T1"
Sheets("FemImplant").Select
RowCount = ActiveSheet.UsedRange.Rows.Count
Set Col = Range("I2:I" & RowCount) 'Substitute with the range which includes your True/False values
Dim i As Integer
i = 1
For Each Cell In Col
If Cell.Value = "True" Then
Cell.Copy
Sheets("T1").Select 'Substitute with your sheet
Range("b" & i).Select
ActiveSheet.Paste
'Get sibling cell
Sheets("FemImplant").Select
Dim thisRow As Integer
thisRow = Cell.Row
Dim siblingCell As Range
Set siblingCell = Cells(thisRow, 2)
siblingCell.Copy
Sheets("T1").Select 'Substitute with your sheet
Range("a" & i).Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues
Sheets("FemImplant").Select
i = i + 1
End If
Next
PasteSpecialは、ActiveSheet.PasteSpecialではなくRange.PasteSpecialである必要があります。それらは異なるものであり、ActiveSheet.PasteSpecialはパラメータ「Paste」を認識しません。
ActiveSheet.Range("a" & i).PasteSpecial Paste = xlPasteValues
これはあなたがしようとしていることですか?
Option Explicit
Sub Sample()
Dim rRange As Range
Dim RowCount As Integer, i As Long
Dim nysheet As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Sheets("T1").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set nysheet = Sheets.Add()
nysheet.Name = "T1"
With Sheets("FemImplant")
RowCount = .Range("I" & Rows.Count).End(xlUp).Row
.AutoFilterMode = False
Set rRange = .Range("I2:I" & RowCount)
With rRange
.AutoFilter Field:=1, Criteria1:="True"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
nysheet.Range("B1").PasteSpecial xlPasteValues
.Offset(1, -7).SpecialCells(xlCellTypeVisible).Copy
nysheet.Range("A1").PasteSpecial xlPasteValues
End With
.AutoFilterMode = False
End With
End Sub
コピー/貼り付けを大幅に短縮できます...
' CopyIfTrue()
Dim Col As Range, Cell As Excel.Range, RowCount As Integer
Dim nysheet As Worksheet, shtFI As Worksheet
Set shtFI = Sheets("FemImplant")
Set nysheet = Sheets.Add()
nysheet.Name = "T1"
RowCount = shtFI.UsedRange.Rows.Count
Set Col = shtFI.Range("I2:I" & RowCount)
Dim i As Integer
i = 1
For Each Cell In Col.Cells
If Cell.Value = "True" Then
Cell.Copy nysheet.Range("B" & i)
nysheet.Range("A" & i).Value = _
shtFI.Cells(Cell.Row, 2).Value
i = i + 1
End If
Next
あなたが提供したコードは以前よりはるかに速いと思います。しかし、他の人が理解しやすくするために、コメントを入れてみませんか?
私はあなたのためにそれをしました。
Sub ExtractData()
Dim selectedRange As Range ' Range to check
Dim Cell As Range
Dim iTotalRows As Integer ' Selected total number of rows
Dim i As Integer ' marker to identify which row to paste in new sheet
Dim shtNew As Worksheet
Dim shtData As Worksheet
Set shtData = Sheets("data")
Set shtNew = Sheets.Add()
shtNew.Name = "Analyzed data"
iTotalRows = shtData.UsedRange.Rows.count
Set selectedRange = shtData.Range("F2:F" & iTotalRows)
i = 1
' Check the selected column value one by one
For Each Cell In selectedRange.Cells
If Cell.Value = "True" Then
Cell.Copy shtNew.Range("A" & i)
' Copy the brand to column B in "Analyzed data" sheet
shtNew.Range("B" & i).Value = _
shtData.Cells(Cell.Row, 2).Value
i = i + 1
End If
Next ' Check next cell in selected range
End Sub