PDA

View Full Version : Getting a 1004 error when ending copy loop at a blank row



mutanthumb
12-03-2012, 12:40 PM
I am trying to copy data starting at a row with cell with value of "Depth (m)" and ending at the next blank row. The number of rows between these will vary and I have 400 spreadsheets to do this on.

I am also new at VBA, so this is a hacked together macro from something else I found.

The error:

Run-time error '1004':
Application-defined or object-defined error

Here is my code:

Sub CopyDepth()
Dim rownum As Long

Dim startrow As Long
Dim endrow As Long
Dim lastrow As Long
rownum = 1
colnum = 1
lastrow = Worksheets("Profile").Range("A65536").End(xlUp).Row
With ActiveWorkbook.Worksheets("Profile").Range("a1:a" & lastrow)

For rownum = 1 To lastrow
Do
If .Cells(rownum, 1).Value = "Depth (m)" Then
startrow = rownum
End If

rownum = rownum + 1

If (rownum > lastrow) Then Exit For

Loop Until .Cells(rownum, 1).Value = ""
endrow = rownum
rownum = rownum + 1

Worksheets("Profile").Range(startrow & ":" & endrow).Copy

Sheets("data").Select
Range("A1").Select
ActiveSheet.Paste

Next rownum
End With
End Sub

It works if change this line:

Loop Until .Cells(rownum, 1).Value = ""

to this:

Loop Until .Cells(rownum, 1).Value = "Doe (Jane, corrected):"

Unfortunately, I can't use that because that text will vary as well from workbook to workbook.

Here I a sample of my data:

Big Lake
29 October, 2012
Joe & Jill
Blue [Big] Lake, Utah (USA)

OLD meter (#00314)
Depth (m) T (deg-C)
0 31.21
1 32.64
2 34.70
3 36.76
4 36.92
5 36.92
6 36.12
7 35.47
8 35.05
9 34.32
10 33.96

Doe (Jane, corrected):
N: 8.0m
S: 8.0m

What I really want to copy is from Depth (m) down to 10 33.96 to a new sheet. I have been picking at this for a while but can't get it. The debugger points to this line:

Worksheets("Profile").Range(startrow & ":" & endrow).Copy
Any assistance would be great. Thanks you! -s

mohanvijay
12-03-2012, 11:41 PM
try this


Dim Yes_Found As Boolean
Yes_Found = False
For rownum = 1 To lastrow

If .Cells(rownum, 1).Value = "Depth (m)" Then
Yes_Found = True
startrow = rownum
End If

rownum = rownum + 1



If Yes_Found = True And Trim(.Cells(rownum, 1).Value) = "" Then
endrow = rownum - 1
Yes_Found = False
Worksheets("Profile").Range(startrow & ":" & endrow).Copy Sheets("data").Range("A1")
End If

Next rownum

mutanthumb
12-04-2012, 10:02 AM
Hi thanks for the reply! Where do I insert this code in my current code?

mutanthumb
12-04-2012, 02:35 PM
Hi-
This was solved in StackOverflow:

Sub CopyDepth()
Dim ws As Worksheet
Dim rng As Range
Set ws = Worksheets("Profile")
Set rng = ws.UsedRange.Find(What:="Depth (m)")
Range(rng, rng.End(xlToRight).End(xlDown)).Copy
Worksheets("data").Range("A1").PasteSpecial
End Sub

Thanks!