Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ' 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
- 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
Add Comment
Please, Sign In to add comment