For Each Loop with copy and paste over multiple worksheets

[PaulWJ]

Afternoon Excel experts. Been working on part of this sheet for most of the day. Have now got to the point where I want to start fixing the data (for neat presentation).

The sheet with the data in it (called PK) works by looking up the date on the Background sheet (Cell named WorkingDate). Based on this, it outputs 3 bits of information next to a cell with the same date in it (on the PK sheet). I also have a list of dates in one column (G) on worksheet (Background).

What I need the loop to do is start at the top of the dates in G, update the WorkingDate cell, then copy the information in the PK sheet and paste it (values only) in separate cells in the PK sheet. (For example, the dates in the PK sheet are in AA4:AA44. The outputs go into columns AB:AD. I need to copy the AB:AD entries and paste (values only) into AE:AG (in the same row as the original). Apologies, I can't provide a copy of the sheet.

I'm testing this on Sheet PK only at the moment, but the plan is to have multiple sheets (for each staff member) so this would ideally be made variable to.

The code I have so far is:

Sub DataUpdate()

Dim dt As Range, hdt As Range
Dim ws As Worksheet, bk As Worksheet
Dim d As Variant
Dim wd As Range

Set dt = Worksheets("Background").Range("G3:G23")
Set ws = Sheets("PK")
Set hdt = Worksheets("PK").Range("AA4:AA44")
Set wd = Worksheets("Background").Range("WorkingDate")

    For Each d In dt
        wd.Value = d  'changes the date to the next one on the list
        
        hdt = Worksheets("PK").Range(hdt).Find(d.Value) 'Looks up the date in the person's sheet
        hdt.Offset(0, 1).Activate 'Activates the cell to the left (of the date)
        
        ActiveCell.Offset(0, 3).Copy '(Copies the 3 cells to the left of the date)
        ActiveCell.Offset(0, 4).PasteSpecial (Pastes the cells on the next 3 cells)
            
    Next d


End Sub

I reckon there are multiple errors in here - The find function is more than likely incorrect, as well as the offset stuff. And the Paste is also missing the section that lets you paste values only.

I'm asking quite a bit and I'm grateful for any assistance. 6pm on a Friday, so nothing getting done here from me until Monday. Have a good weekend folks

 

[Sam_D_Ben]

Something like this,

Sub DataUpdate()
    Dim d As Range, f As Range
    For Each d In Sheets("Background").Range("G3:G23")
        Sheets("Background").Range("WorkingDate").Value = d.Value
        Set f = Sheets("PK").Range("AA4:AA44").Find(d.Value, LookAt:=xlWhole)
        If Not f Is Nothing Then f.Offset(0, 4).Value = f.Offset(0, 3).Value
    Next d
End Sub