Registration whether to eat or not

[KlausW]

Hi Excel helpers.

I have two sheets, called Time and Registration. Registration is a sheet with input cells in columns C, E and G. In columns B, D F and H there are formulas. In cell A2, you can choose between 25 people (initials) via a drop down. B4 to B10 show the dates for a particular week. Week number appears, via drop down, from cell G2. The input cells are thus in

C4: C10

E4: E10

G4: G10

It is thus the three areas, and not anything else, that you want to copy to sheet Time (via a button) for each new person / week selected in A2 / G2.

Sheet Time is structured as follows:

Column A contains dates (dd-mmmm-yyyy) for an entire year and column B contains the week number of the date in column A.

From column G and out to column EZ (150 in total) there is room for data for the 25 people. For each person, six columns are set aside - first person from column G: L, next person from column M: R and so on, six columns for each person. First person initials are in G1, next person initials in M1 and so on. What is entered in sheets Registration for a given person and a given date must now be copied to sheets Time in the correct cells, ie G: I for first person, M: O for second person, S: U for third person and so on. The last three columns for each person, ie J: L for the first person, P: R for the second person and so on must contain formulas, but that part does not need to include the VBA code.

All help will be appreciated.

Regards Klaus W

 

[KlausW]

Got it from somewhere else, but thanks KW

 

[Peter_SSs]

Got it from somewhere else, but thanks KW

Glad you got it resolved. If you would like to post what the solution was then it is perfectly fine to mark that post as the solution to help future readers.
Otherwise no post should get marked so I have removed it from post #2.

 

[KlausW]

Glad you got it resolved. If you would like to post what the solution was then it is perfectly fine to mark that post as the solution to help future readers.
Otherwise no post should get marked so I have removed it from post #2.

This is the code.

Sub Rektangelafrundedehjørner4_Klik()

Dim DatRng, Dest As Range
Dim TidCol, TidRow, c  As Integer

 With Sheets("Tilmelding")
    Set DatRng = .Range("C4:C10")
 On Error GoTo Ooops
    TidCol = Application.Match(.Range("A2"), Sheets("Tid").Range("1:1"), 0)
    TidRow = Application.Match(.Range("B4"), Sheets("Tid").Range("C:C"), 0)
 End With
 
For c = 0 To 2
    Set Dest = Sheets("Tid").Cells(TidRow, TidCol).Offset(0, c).Resize(7, 1)
    Dest.Value = DatRng.Offset(0, 2 * c).Value
 Next c
 
Ooops:
 If Not Err.Number = 0 Then MsgBox " Not able to match Initial or Date  -- Please check and try again"
On Error GoTo 0

End Sub