0

I would like to loop through column A in Worksheet1 and find the first cell which has a specified text "Oil Production". This cell is the first cell in the array I wish to copy to Worksheet2. This cell and the size of the array will change from time to time, hence the code I have used. I then paste it into cell B7 in Worksheet2 which will never change.

This is my formula. I get the error at line ActiveSheet.Paste

Sub Test()
    Application.ScreenUpdating = False
    For Each Cell In Sheets("Sheet1").Range("A:A")
        If Cell.Value = "Oil Production" Then
            ActiveSheet.Cells.Select
            Range(ActiveCell, Cells(ActiveCell.End(xlDown).Row, ActiveCell.End(xlToRight).Column)).Select
            Selection.Copy
            Sheets("Sheet2").Select
            Range("B7").Select
            ActiveSheet.Paste
        End If
    Next
End Sub
Community
  • 1
  • 1
Steve85
  • 1
  • 1
  • 1
  • Changing `ActiveSheet.Cells.Select` to `Cell.Select` will solve your immediate issue. That said, this code is flawed on many levels: disabling `Application.ScreenUpdating = False` for debugging would have allowed you to see your issue; looping over the entire column A is unnecessary and slow; use of `Select` is unnecessary, slow and fragile [see here on How](http://stackoverflow.com/a/10717999/445425) – chris neilsen Jun 18 '15 at 01:40
  • Thanks for link and comments – Steve85 Jun 18 '15 at 01:49

1 Answers1

-1

resize the area:

Sub Test()
Dim MyRowCount As Long, MyColCount As Long
Application.ScreenUpdating = False
For Each Cell In Sheets("Sheet1").Range("A1:A" & Range("A" & Rows.count).end(xlup).row) 'This make it poll the used data rather than the whole column
    If Cell.Value = "Oil Production" Then
        ActiveSheet.Cells.Select
        With Range(ActiveCell, Cells(ActiveCell.End(xlDown).Row, ActiveCell.End(xlToRight).column))
            .Copy
            MyRowCount = .Rows.Count
            MyColCount = .Columns.Count
        End With
        Sheets("Sheet2").Select
        Range("B7").Resize(MyRowCount, MyColCount).PasteSpecial xlPasteAll
        'Do you need to flick back to Sheet1 after pasting?
    End If
Next
End Sub

Also I took out a bunch of selects for you.

Range("A1").Select
Selection.Paste

can be written as

Range("A1").PasteSpecial XLPasteAll

You can chop out most selects this way, you can see I have also done it with the Range you are copying

Dan Donoghue
  • 6,056
  • 2
  • 18
  • 36
  • Just a follow up question. This code does not seem to work that well when there is no data in A1. Or when there are empty cells in the column. I get an error at line Range("B7").Resize(MyRowCount, MyColCount).PasteSpecial xlPasteAll – Steve85 Jun 18 '15 at 02:29
  • Just put an if MyRowCount <> 0 AND MyColCount <> 0 then before the paste and an End if after it, if those are not set to a positive value then there is obviously no data to paste. – Dan Donoghue Jun 18 '15 at 03:46