'1004': Application-defined or object defined error (VBA)

[jBenzer]

Hi,

I am pretty new to VBA and I have been trying to execute the following code however, it is giving me an error "Application-defined or object-defined error". I am unable to figure out where am I going wrong.

Can someone please review my code and help me fix it? Thank you very much in advance :)

Sub SelectBetween()

Dim sourceRange As Range
Dim transposeRange As Range
Dim rowCount As Integer
Dim rangeCount As Long

'Initialize rowCount'
rowCount = 0

Worksheets("sheet1").Activate

'Determine max number for loop'
Set sourceRange = Range(Range("A:A").Find("abc"), Range("A:A").Find("xyz"))
rangeCount = sourceRange.Rows.Count
Debug.Print rangeCount

For i = 1 To rangeCount

Set sourceRange = Range(Range("A:A").Find("FROM"), Range("A:A").Find("RXNBR"))
'sourceRange.Select'

'Copy range to transpose'
sourceRange.Copy

'Transpose the selected range'
Set transposeRange = ActiveSheet.Cells(rowCount + 1, "B")
transposeRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

sourceRange.Delete

rowCount = rowCount + 1


Next i

'Delete empty column A'
Columns(1).EntireColumn.Delete

End Sub

[Artik]

Indicate in which line of code you get an error.
And it's best if you put a representative attachment, because I can see that you are doing strange things with this macro.

Artik

[jBenzer]

Hi Artik,

Please find attached representation of what I am trying to achieve. I am trying to select a range of cells starting with "abc" and ending with "xyz" and then transposing it to Column B (Starting with B1, B2 and so on). Sorry for the confusion.

24613

[Artik]

For the future, macros can not be tested on the image.

eg:
Sub AAA()
Dim rowCount As Long
Dim sourceRange As Range


On Error GoTo HandleError


Application.ScreenUpdating = False


With Worksheets("sheet1")
.Activate


Do
Set sourceRange = Nothing


'A runtime error is created when the range can not be defined ("abc" or/and "xyz" was not found)
Set sourceRange = .Range(.Range("A:A").Find("abc"), .Range("A:A").Find("xyz"))


If Not sourceRange Is Nothing Then
sourceRange.Copy
.Cells(rowCount + 1, "B").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=True
sourceRange.Clear
rowCount = rowCount + 1
End If


Loop Until sourceRange Is Nothing


HandleExit:
.Range("A1").Select
End With


Exit Sub


HandleError:
If sourceRange Is Nothing Then
Resume HandleExit
Else
MsgBox Err.Number & vbLf & Err.Description, vbExclamation
End If
End Sub

Artik