View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default Prompt to overwrite

For Each ws In wbMaster.Worksheets
strEmp = ws.Name
For Each ws2 In wbMth.Worksheets
If IsError(Application.Match(strEmp, _
ws2.Range("B1:Z1"), 0)) Then
'do nothing
Else
col = Application.Match(strEmp, _
ws2.Range("B1:Z1"), 0)
set rng = ws2.Range(ws2.cells(2,col+1), _
ws2.Cells(LastRow,Col+1))
set rng1 = ws.Cells(2,i+1).Resize(rng.rows.count,rng.columns. count)
if application.countA(rng1) 0 then
res = msgbox "Overwrite", vbYesNo
if res = vbYes then
rng.Copy _
Destination:=ws.Cells(2, i + 1)
end if
Exit For
End If
Next


--
Regards,
Tom Ogilvy


"Karen" wrote in message
om...
The portion of code below courtesy of Debra Dalgliesh(thanks again)
pastes data into cells B1:Z1.
The problem I have is that it will overwrite existing data. I realise
that the destination cells need testing and if data exists prompt the
user (by messagebox?) for confirmation to overwrite/cancel.
I would appreciate any help in achieving this.

For Each ws In wbMaster.Worksheets
strEmp = ws.Name
For Each ws2 In wbMth.Worksheets
If IsError(Application.Match(strEmp, _
ws2.Range("B1:Z1"), 0)) Then
'do nothing
Else
col = Application.Match(strEmp, _
ws2.Range("B1:Z1"), 0)
ws2.Range(ws2.Cells(2, col + 1), _
ws2.Cells(LastRow, col + 1)).Copy _
Destination:=ws.Cells(2, i + 1)
Exit For
End If
Next

TIA
Karen