View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.misc
arepemko via OfficeKB.com arepemko via OfficeKB.com is offline
external usenet poster
 
Posts: 8
Default macro paste by matching dates

Im new to writing macros so I dont know exactly what to change is there any
way I can email you the workbook that im working on so that you can what I am
trying to do and maybe I can have a better idea of what im doing.
thank you very much for your help.

stevebriz wrote:
Try this :
I just used sheet1, sheet2 and sheet4.
and used col A rows 1-500 on sheets 2 & 4 for the serach ranges...you
can change this as needed.

Sub CPYACROSS()
Application.ScreenUpdating = False
' ==== Get date to use=====
Sheet1.Select
Dim Sdate As String
Sdate = Sheet1.Range("B6").Value
' ====Search and copy section==========
Sheet2.Activate
With Sheet2.Range("A1:A500") ' looking in column sheet2 column A rows
1-500
Set c = .Find(Sdate, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do

Sheets(2).Range(Cells(c.Row, 2), Cells(c.Row, 5)).Select
Selection.Copy
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
' ====Search and Paste section==========
Sheet4.Select
With Sheet4.Range("A1:A500") 'looking in column sheet4 column A rows
1-500
Set d = .Find(Sdate, LookIn:=xlValues)
If Not d Is Nothing Then
firstAddress = d.Address
Do
Sheet4.Range(Cells(d.Row, 2), Cells(d.Row, 4)).Select
Selection.PasteSpecial xlPasteValues,
xlPasteSpecialOperationNone
Set d = .FindNext(d)
Loop While Not d Is Nothing And d.Address < firstAddress
End If
End With
Sheet1.Select

Application.ScreenUpdating = True
End Sub


--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...excel/200609/1