PDA

View Full Version : Solved: Copy data with values & paste in another worksheet



Dave T
02-20-2013, 06:21 PM
Hello All,

I have a spreadsheet that is used to process truck heavy load permit applications.

On the first sheet called 'Heavy Load Register' we manually assign each application a HL number, and then from the permit we add:

Column B - Date application assessed
Column C - 'y' if it is an enquiry
Column D - The operator/truck company name
Column E - What the load is
Column F - Where they are going from and to
Column G - What level of assessment it is
Column H - How long it took from receiving the application to us processing it and sending it backFor applications that are enquiries (identified by 'y' in column C) we transfer the details for the worksheet called 'Heavy Load Register' to the worksheet called 'Non-Standard Studies'.
Currently this is a clumsy copy and paste and I would like to automate the process.

What I am after is a macro that will find all instances of 'y' in column C of the worksheet called 'Heavy Load Register' and copy associated data from other columns A, B, C, D, E, F & H to the worksheet called 'Non-Standard Studies'.

I have found a macro that works but it only copies one column and it deletes any borders in the destination.
To copy the other associated data I have used VLOOKUP but I am sure a macro could do this cleaner.



Sub RangeCopyPaste()
'http://stackoverflow.com/questions/13470007/copy-all-cells-with-certain-value-into-another-column-skipping-blanks
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1
For Each cell In Worksheets("Heavy Load Register").Range("C2:C1000")
If cell.Value = "y" Or cell.Value = "Y" Then
If MyCount = 1 Then Set NewRange = cell.Offset(0, -2)
Set NewRange = Application.Union(NewRange, cell.Offset(0, -2))
MyCount = MyCount + 1
End If
Next cell
NewRange.Copy Destination:=ActiveSheet.Range("B6")
End Sub


If someone could help me out with a macro that would copy all of the data to the other worksheet, or at the very minimum just copy the HL number without any formatting to the destination worksheet (i.e. paste values) it would be greatly appreciated.

Regards,
Dave T

Simon Lloyd
02-20-2013, 10:41 PM
Use your lookup formulae as you have now and run thisSub copy_it()
Dim rng As Range, MyCell As Range
Set rng = Sheets("Heavy Load Register").Range("A3:A" & Sheets("Heavy Load Register").Range("A" & Rows.Count).End(xlUp).Row)
For Each MyCell In rng
If MyCell.Offset(0, 2).Value = LCase("y") Then
MyCell.Copy Destination:=Sheets("Non-Standard Studies").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next MyCell
End Subshould do what you need :)

Dave T
02-20-2013, 11:21 PM
Hello Simon,

I appreciate your reply.

Your reply works well, but I have just realised the problem with the borders on the 'Non-Standard Studies'.
Both macros copy the HL numbers, but as the worksheet called 'Heavy Load Register' does not have any borders applied it is making a direct copy of these cells and this borderless copy is the one copied to the other worksheet.

I was stumped trying to modify the line NewRange.Copy Destination:=ActiveSheet.Range("B6") or even your line MyCell.Copy Destination:=Sheets("Non-Standard Studies").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) to paste the copied data as values. That way there would be no formulas copied or any formatting and the formatting and borders of the destination cells would apply.

Can Paste Special... > Values be added to the code so that only the values are pasted.

Regards,
Dave T

Simon Lloyd
02-20-2013, 11:37 PM
Does this do it for you?Sub copy_it()
Dim rng As Range, MyCell As Range
Set rng = Sheets("Heavy Load Register").Range("A3:A" & Sheets("Heavy Load Register").Range("A" & Rows.Count).End(xlUp).Row)
For Each MyCell In rng
If MyCell.Offset(0, 2).Value = LCase("y") Then
MyCell.Copy
Sheets("Non-Standard Studies").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next MyCell
Application.CutCopyMode = False
End Sub

Dave T
02-20-2013, 11:49 PM
Thank you very, very much Simon,

It works well and it looks like all I needed to do was remove the Destination part of the line and add some extra code.

I appreciate your patience.

Regards,
Dave T