I am trying to make a Macro that would copy and paste a range of numbers in Exce

Question

I am trying to make a Macro that would copy and paste a range of numbers in Excel. After it is pasted I want to move to the next set of data and copy and paste that also. Basically, Copy range cells starts at "test" and ends at the last "0" that is 13 rows down from test and 6 columns to the right . Here what I have so far (please see below). The Macro would copy the range of cell I need and paste those cells where I need them; however, it would not move to the next set of data. I included an example of the worksheet below and also attached a copy of a example worksheet

EXAMPLE MACRO

Sub RunTest2()

'

' RunTest2 Macro

'

' Select cell A2, *first line of data*.

      Range("A20").Select

      ' Set Do loop to stop when an empty cell is reached.

      Do Until IsEmpty(ActiveCell)

        Range("A20:F33").Select

        Selection.Copy

        Range("L20").Select

        ActiveSheet.Paste

        Range("A33").Select

        ActiveCell.Offset(1, 0).Select

    Loop

End Sub

EXAMPLE SPREADSHEET:

Record #1 Jan 31 2005 16:04:03 HRC HV mm 15000 PART # 4T-1388 LOT # CELL # 663 SCAN SPEED 0.14 % KW 50 COIL # 543214 STEEL HEAT 90456 - - - # Traverses 1 Traverse 1 Case Hardness: 50 6 10 9.0381 Pass 40 0 0 9.51429 30 10 15 9.99048 Fail Surface Test 0 0 0 0 Test Points 12 1 4.5 0 0 54.8 2 5.5 0 0 55.2 3 5.75 0 0 55.8 4 6 0 0 55.6 5 6.5 0 0 55.6 6 7.5 0 0 55.4 7 9 0 0 50.8 8 10 0 0 29.8 9 10.5 0 0 25.6 10 11 0 0 22.1 11 12 0 0 18.1 12 15 0 0 14.7 Core Test 0 0 0 0 Record #2 Feb 1 2005 2:31:25 HRC HV mm 15000 PART # 9J6688 LOT # CELL # 664 SCAN SPEED 0.185 % KW 75 COIL # 543228 STEEL HEAT 90455 - - - # Traverses 1 Traverse 1 Case Hardness: 50 6 10 10.09507 Fail 40 0 0 10.44718 30 10 15 10.86638 Pass Surface Test 0 0 0 0 Test Points 12 1 4.5 0 0 48.5 2 5.5 0 0 55.8 3 5.75 0 0 57.3 4 6 0 0 57.5 5 6.5 0 0 56.3 6 7.5 0 0 59.4 7 9 0 0 57.1 8 10 0 0 52.7 9 10.5 0 0 38.5 10 11 0 0 26.9 11 12 0 0 19 12 15 0 0 10.4 Core Test 0 0 0 0 Record #3 Feb 1 2005 5:57:19 HRC HV mm 15000 PART # 110-3118 LOT # 3118 CELL # 663 SCAN SPEED 0.145 % KW 50 COIL # 543214 STEEL HEAT 27629 - - - # Traverses 1 Traverse 1 Case Hardness: 50 6 10 9.13218 Pass 40 0 0 9.7069 30 10 15 10.36029 Pass Surface Test 0 0 0 0 Test Points 12 1 4.5 0 0 53.7 2 5.5 0 0 55.2 3 5.75 0 0 56.3 4 6 0 0 55.4 5 6.5 0 0 56.5 6 7.5 0 0 55.4 7 9 0 0 52.3 8 10 0 0 34.9 9 10.5 0 0 28.1 10 11 0 0 25.4 11 12 0 0 19.2 12 15 0 0 11.5 Core Test 0 0 0 0

Explanation / Answer

Here is a modified version of my previous code. This does use the .Find feature and would be a bit faster than the other when your data is huge and takes up several thousand or hundreds of thousands of rows on a sheet - and it would work just as well as the other on smaller data sets.

Sub CopyUsingFind()
'the sheet with the data must be active
'when this macro is run.
'copies data from A:F for Test entries
'into L:Q on the same rows of the same sheet
Const findPhrase = "Test"
Const rowsToCopy = 13
Const firstCopyCol = "A"
Const lastCopyCol = "F"
Const copyToCol = "L"

Dim searchRange As Range
Dim anyCell As Range
Dim copyRange As Range
Dim firstAddress As String

Set searchRange = ActiveSheet.Range("A1:" & _
   ActiveSheet.Range("A" & Rows.Count).End(xlUp).Address)
Application.ScreenUpdating = False ' improve performance
With searchRange
    Set anyCell = .Find(findPhrase, LookIn:=xlValues, MatchCase:=False)
    If Not anyCell Is Nothing Then
      firstAddress = anyCell.Address
      Do
        'perform copy of one data set
        Set copyRange = _
         Range(firstCopyCol & anyCell.Row & ":" _
         & lastCopyCol & anyCell.Row + rowsToCopy)
        copyRange.Copy Destination:= _
         Range(copyToCol & anyCell.Row)
        Application.CutCopyMode = False
        'look for the next "Test" entry in column A
        Set anyCell = .FindNext(anyCell)
        If anyCell Is Nothing Then
          Exit Do
        End If
      Loop While Not anyCell Is Nothing And anyCell.Address <> firstAddress
    End If
End With
Set searchRange = Nothing ' release assigned resource back to the system.
End Sub

Related Questions

Navigate

• Browse (All)
• Browse I
• Subjects

---

---

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.