Kaava hukassa

originaalissa valitse haluamasi kuukausi välilehdeltä sarakkeesta A se päivämäärä, jonka rivitiedot haluat siirtää osastojen työkirjoihin

moduuliin...

Sub Siirrä()
Dim Päivä As Integer
Dim Kuukausi As String
Dim Vuosi As Integer
Dim Haku As String
Dim Myynti As Double
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If ActiveCell = "" Then
MsgBox "Valitsemasi solu on tyhjä!"
Exit Sub
End If
Päivä = ActiveCell
'MUUTA TEKSTI JOS TAULUKKO EI OLE NIMETTY TAMMIKUU, HELMIKUU...
'JOS TAMMI, HELMI... NIIN MUUTA TAMMI, HELMI...
Select Case UCase(ActiveSheet.Name)
Case "TAMMIKUU"
Kuukausi = 1
Case "HELMIKUU"
Kuukausi = 2
Case "MAALISKUU"
Kuukausi = 3
Case "HUHTIKUU"
Kuukausi = 4
Case "TOUKOKUU"
Kuukausi = 5
Case "KESÄKUU"
Kuukausi = 6
Case "HEINÄKUU"
Kuukausi = 7
Case "ELOKUU"
Kuukausi = 8
Case "SYYSKUU"
Kuukausi = 6
Case "LOKAKUU"
Kuukausi = 7
Case "MARRASKUU"
Kuukausi = 8
End Select
'MUUTA TARVITTAESSA
Vuosi = 2008

'MUUTA työkirjojen nimet b,c,d...
'B SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 1)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "b"


'C SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 2)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "c"


'D SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 3)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "d"


'E SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 4)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "e"


'F SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 5)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "f"


'G SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 6)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "g"


'H SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 7)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "h"


'I SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 8)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "i"


'J SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 9)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "j"


'K SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 10)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "k"


'L SARAKKEEN OSASTO
Myynti = ActiveCell.Offset(0, 11)
Haku = Päivä & "." & Kuukausi & "." & Vuosi
EtsiJaSiirrä Haku, Myynti, "l"

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Function EtsiJaSiirrä(Päiväys As String, Tieto As Double, Osasto As String) As Range
Dim Solu As Range
Dim Työkirja As Workbook
Päiväys = Format(Päiväys, "Short Date")
On Error Resume Next
'MUUTA POLKU
Set wb = Workbooks.Open("C:\Documents and Settings\Kunde\Omat tiedostot\" & Osasto & ".xls", False, False)
wb.Sheets(1).Activate
Set Solu = Cells.Find(What:=CDate(Päiväys), After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
Range(Solu.Address).Offset(0, 1) = Tieto
On Error GoTo 0
wb.Close True
End Function

Keep Excelling
@Kunde