Reconize month and than reconize number and then copy the next cells.

[esbenhaugaard]

I have this code that reconize the numbers from the worksheet-'oversigt' and finds these number in the second worksheet and than copy the next 6 cells to the right from the number and paste it into sheet 1 next to the number that was reconized.

Question: I want the code to reconize the month to the left in sheet 2, so I can add some month bottoms to sheet 1.

Lets say I push bottom 'Jan' in sheet one: than it should find the represented month - that it finds the numbers that belongs to that month (using the same code as I already made)...and so on.

Should I add a loop into my codes that tells it or how? Maybe something like find(what:="Jan", after(Find:=c, after:xl....and so on?)


I have attached the workbook

Hope you understand my question!??


Code
..................................................
Sub NIOMRÅDE() ' Finder data i NIdata og indsætter dem i korrekte områder
Dim c As Range, LR As Long, x As Long, FC As Range 'declare variables


Range("O17") = "NI"
Range("M18") = "Omr"
Range("N18") = "A"
Range("O18") = "B"
Range("P18") = "O"
Range("Q18") = "P"
Range("R18") = "NO"
Range("S18") = "BS"
With ActiveSheet 'with the active worksheet

LR = Range("L6555").End(xlUp).Row 'set Lr equal to the last row in column L that contains a value
For Each c In .Range("L20:L" & LR).Cells 'loops through cells in column L from row 20 to LR (defined above)
On Error Resume Next 'if error keep going
With Sheets("NIdata") 'with the NIdata worksheet in this workbook

'set fc equal to the found cell whose value is equal the current cell in the
'c loop's value
Set FC = .Columns(9).Find(What:=c.Value, After:=.Cells(1, 9), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
On Error GoTo 0 'error go to nothing
If Not FC Is Nothing Then 'if fc is found then
.Range(FC.Offset(0, 1), FC.Offset(0, 6)).Copy 'copy the cells one to the right
'to 6 to the right of the found cell
'columns J through O
With ActiveSheet 'with the activesheet
c.Offset(0, 2).PasteSpecial 'paste the copied information to cells to the right
'of the current cell in the loop
End With

End If

End With


Next c 'move to next cell in the c loop
End With



Range("A1").Select

End Sub
...........................................