How to copy only one value from range to worksheet

D

Dakota

I have a worksheet called 'Exceptions' with data that I need to have applied
to multiple worksheets within the workbook based upon the value in A1
matching the value of B6 on the individual worksheets. This matching works,
but I need to have only the B column value on the 'Exceptions' sheet added to
each worksheet. The code below is copying the entire row of data (6 columns)
from the 'Exceptions' worksheet where the A1 value matches the B6 value on
the worksheets (which is what i initially wanted but now I need to strip
everything and only copy the one cell).

Can someone show me where I can make this change? Every time I do it, I get
different data sets added to my worksheets.



Sub Exceptions()

Dim r As Range, cell As Range, sh As Worksheet
Dim lastrow As Long
With Worksheets("Exceptions")
Set r = .Range(.Range("A1"), .Range("A1").End(xlDown))
End With
For Each cell In r
For Each sh In Worksheets
If LCase(sh.Name) <> "exceptions" Then
If sh.Cells(6, "B").Value = cell Then

If Application.CountIf(sh.Columns(1), cell) > 0 Then
lastrow = sh.Cells(Rows.Count, 1).End(xlUp).Row
cell.Resize(1, 6).Copy
sh.Cells(lastrow + 1, 1).PasteSpecial xlPasteValues
Else
cell.Resize(1, 6).Copy
sh.Range("A50").PasteSpecial xlPasteValues
End If
Exit For
End If
End If
Next
Next
End Sub
 
J

JLGWhiz

You have this in two places in your code:

cell.Resize(1, 6).Copy

In both places, change it to:

cell.Offset(0, 1).Copy
 
D

Dakota

That works perfectly!

I have another question about this. The data is being added to the
appropriate cell on the individual worksheets due to me specifying the exact
field (sh.Range("P16").PasteSpecial xlPasteValues) in the code.

Is there a way to have another data match between the 'Tickets' worksheet
and the others to have it dynamically add the value to the correct field?

For example, in the 'Tickets' sheet Column A=Name, Column B= Tickets, Column
C= Date (03/01/2009 format)

On the worksheets the date is specified in Column A (03/01/2009 format).

Is there a way to have the date in Column C on the 'Tickets' sheet match to
the date in Column A on the sheet that matches that name and have the number
put into Column P on the row with the date match?

This would save me some time. I currently go into the macro daily and
change the destination cell.

Thanks!
 
J

JLGWhiz

Is there a way to have the date in Column C on the 'Tickets' sheet match to
the date in Column A on the sheet that matches that name

What name? The sheet name or the name in one of the columns on a sheet,
which is not yet defined? Are you trying to match both names and dates?

You need to clarify exactly what you want to do and where the data is
located on the sheet in rows or columns.
 
D

Dakota

Sorry if I was not clear enough.

Data is on worksheet named 'Tickets'
Column A - Usernames (ABROOK, DPELTIER, etc.)
Column B - Ticket Count (3, 18, 4, etc.)
Column C - Date (3/2/2009)

Worksheets have been created for users and the usernames are referenced in
cell B6 on the individual user worksheets.

On the user worksheets, Rows 15 - 45 - Column A reference a date (i.e. A15 =
3/1/2009, A16 = 3/2/2009, etc.)

Ticket Count needs to be applied to Column P on the user worksheets in the
row that matches the date in Column A with the date in Column C on the
'Tickets' worksheet.

The code I have below, will move the Ticket Count to the correct worksheet
and to the correct row but only because I change the cell in the macro
manually. I would like the date match to set what row in Column P the Ticket
Count should go into. Currently I have to change the sh.Range cell daily to
have the data applied to the correct cell.


Sub Tickets()

Dim r As Range, cell As Range, sh As Worksheet
Dim lastrow As Long
With Worksheets("Tickets")
Set r = .Range(.Range("A1"), .Range("A1").End(xlDown))
End With
For Each cell In r
For Each sh In Worksheets
If LCase(sh.Name) <> "tickets" Then
If sh.Cells(6, "B").Value = cell Then
cell.Offset(0, 1).Copy
sh.Range("P16").PasteSpecial xlPasteValues
End If
End If
Next
Next
End Sub

* I am matching the name in Row A on 'Tickets' to the value in B6 on each
worksheet then, I am matching the Date in Row C on 'Tickets' to the value in
Row A on each worksheet which tells which row in Column P the Ticket count
needs to be applied to.

Right now I make that date comparison, and change the code above to have the
cell copied to P15 (if the data was for 3/1/2009).

I hope this clarifies what I am trying to do.
 
J

JLGWhiz

Give this a shot. I did not test it, so if it hiccups, post back.

Sub Tickets()

Dim r As Range, cell As Range, sh As Worksheet
Dim lastrow As Long, c As Range, fDate As Date
With Worksheets("Tickets")
Set r = .Range(.Range("A1"), .Range("A1").End(xlDown))
End With
For Each cell In r
For Each sh In Worksheets
If LCase(sh.Name) <> "tickets" Then
If sh.Cells(6, "B").Value = cell Then
fDate = cell.Offset(0, 2).Value
cell.Offset(0, 1).Copy
Set c = sh.Range("A15:A45").Find(fDate, LookIn:=xlValues)
If Not c Is Nothing Then
sh.Range("P" & c.Row).PasteSpecial xlPasteValues
End If
End If
Next
Next
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top