Help With Copy Code!

[APElliott]

Hello, I,ve got the following code that needs adding to, but I don't know how. Can YOU help?

Just before I run my macro I want to copy the data on the same row, but in columns A to C. The distination is to a sheet called "Coins". I want to 'find' its paste location by finding the first "0" in column D, and then offsetting back to column A.

Thankyou in advance!

Andrew

Sub CoinsRoutine()

Range("z3&quot.Select
Do Until ActiveCell.Value = ""
ActiveCell.Copy Destination:=ActiveCell.Offset(0, -22)

'run my macro'

ActiveCell.Offset(0, -22).ClearContents
ActiveCell.Offset(1, 0).Select
Loop
Range("d3&quot.Select
End Sub

 

[xlbo]

Or - instead, you could post a further explanation here. Why should someone spend their money calling you ??
This is way out of line with TT policies

Rgds, Geoff
Quantum materiae materietur marmota monax si marmota monax materiam possit materiari?
Want the best answers to your questions ? faq222-2244

 

[APElliott]

Sorry if I've upset you.

I didn't realise it was illegal to leave phone numbers.

Some people do say Time is money, and some people do take their time to respond positively.

Emails also cost money, and you have kindly help me out in this way before.

Once again please accept my apologies.

Regards,

Andrew

PS I think I'm almost there with the code, except I've only got it to copy B instead of A to C.

Sub CoinsRoutine()
Sheets("BoQ&quot.Select
Range("A2&quot.Select
Selection.RemoveSubtotal
LRow = Range("b65536&quot.End(xlUp).Row
LCol = Range("s1&quot.Column
Range(Cells(2, 1), Cells(LRow, LCol)).Select
Range("d3&quot.Select
If ActiveCell.End(xlDown).Row < 65528 Then
Range(ActiveCell, ActiveCell.End(xlDown)).Select
End If
Selection.Copy
Range(&quot;z3&quot.Select
ActiveSheet.Paste
Range(&quot;z3&quot.Select
Do Until ActiveCell.Value = &quot;&quot;
ActiveCell.Copy Destination:=ActiveCell.Offset(0, -22)


ActiveCell.Offset(0, -24).Select
Selection.Copy
Sheets(&quot;Coins&quot.Select
Columns(&quot;D&quot.Select
Selection.Find(What:=&quot;0&quot;, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _
:=True, SearchFormat:=False).Activate
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, -3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(&quot;BoQ&quot.Select


ActiveCell.Offset(0, 2).ClearContents
ActiveCell.Offset(1, 24).Select
Loop
Range(&quot;z3&quot.Select
If ActiveCell.End(xlDown).Row < 65528 Then
Range(ActiveCell, ActiveCell.End(xlDown)).Select
End If
Selection.Copy
Range(&quot;d3&quot.Select
ActiveSheet.Paste
Range(&quot;z3&quot.Select
If ActiveCell.End(xlDown).Row < 65528 Then
Range(ActiveCell, ActiveCell.End(xlDown)).Select
End If
Selection.ClearContents
Range(&quot;d3&quot.Select
End Sub