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
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