VBA vraag, redelijk ingewikkeld!!!

[roortman]

Dear all,

I got a question.
First of all, you can request the excel file i am working on by sending me a message, then I'll send the file to you.
It will be hard for me to explain what I want to do, since it is a quite large sheet.

But to be short, I have a few number of rows with in column A the department name. and a few columns later some functions that calculate a value. And I have separerate sheets for each month, but not more then 6 months back.

I already have built a macro that creates a new sheet and moves it to the end, asks me to open a sheet where it copies the data from. And also pastes the new values into it.
Now I also have a sheet called (in dutch) "Totaal Service Calls", which holds all values for each departement for each month.
Now here comes the tricky part which I can't solve.
I want a macro that when it runs copies all the data to the right cells. Not that hard to do it hardcoded, but I want it to search for the department in one sheet and then copies the values to the "Totaal Service Calls" sheet under the same department. With the oldest month on top per department, but like i said never more then 6 months.

Underneith you will find all the code I have created so far for those interested;

Underneith it the macro I have already built for importing data and creating a seperate sheet each month:

Sub Maandelijkse_bijwerking()

'test macro select and replace
Dim MyDate, MyMonth, MyMonthName, MySheetNumber
MyDate = Date$ 'Datum in dd-mm-jjjj
MyMonth = Month(MyDate) 'Maand in mm
MyMonthName = MonthName(MyMonth) 'Maand in Long
MySheetNumber = Sheets.Count 'Tellen van sheets in workbook
Dim myfilename As Variant


'Nieuwe sheet maken achteraan in de workbook
Sheets("Service Calls April").Select
Sheets("Service Calls April").Copy after:=Sheets(MySheetNumber)
Sheets("Service Calls April (2)").Select
Sheets("Service Calls April (2)").Name = "Service Calls" & " " & MyMonthName
'Nieuwe sheet toegevoegd
'Nieuwe sheet leegmaken
With ActiveSheet
Range(.Cells(12, 1), .Cells(LastRow(ActiveSheet), 7)).ClearContents
End With
'Openen nieuwe openview download en kopieren
ChDir "C:\Documents and Settings\robboort\Desktop\Report CCA Overleg\"
myfilename = Application.GetOpenFilename _
(filefilter:="All files (*.*),*.*")
Workbooks.Open (myfilename)
With ActiveWorkbook.ActiveSheet
Range(.Cells(1, 1), .Cells(LastRow(ActiveSheet), 7)).Copy _
Destination:=Workbooks("Reporting CCA test.xls").ActiveSheet.Cells(12, 1)
End With
ActiveWorkbook.Close
'Aanvullen van formule naar laatste regel op de sheet
With ActiveSheet
Range(.Cells(13, 8), .Cells(13, 17)).Select
Selection.AutoFill Destination:=Range(.Cells(13, 8), .Cells(LastRow(ActiveSheet), 17)), Type:=xlFillDefault
.Calculate
End With

End Sub

And here are the functions I so far created:

Function LastRow(sh As Worksheet)

Application.Volatile

On Error Resume Next
LastRow = sh.Cells.Find(what:="*", _
after:=sh.Range("A1"), _
lookat:=xlPart, _
LookIn:=xlFormulas, _
searchorder:=xlByRows, _
searchdirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0

End Function

Function LastCol(sh As Worksheet)

Application.Volatile True

On Error Resume Next

LastCol = sh.Cells.Find(what:="*", _
after:=sh.Range("A1"), _
lookat:=xlPart, _
LookIn:=xlFormulas, _
searchorder:=xlByColumns, _
searchdirection:=xlPrevious, _
MatchCase:=False).Column

On Error GoTo 0

End Function
Function MaandelijksTotaal(Afdeling As String, sh As Worksheet) As Variant

With sh

For x = 1 To LastRow(sh)

If .Cells(x, 1) = Afdeling Then

MaandelijksTotaal = Range(.Cells(x, 9), .Cells(x, 17)).Value
Exit For

End If

Next x

End With

End Function

And last but not least, here is the code I have created so far for coping the data to the "Totaal Service Calls" sheet. But as you will see, this is hardcoded. And I want it all to do it itself.

Sub test()

Dim test As Variant
Dim Afd As String
Dim SHMaand As Worksheet

Afd = "CCA Finance & Controlling / HR"
Set SHMaand = Worksheets("Service Calls Juni")
test = MaandelijksTotaal(Afd, SHMaand)
With Worksheets("Totaal Service Calls")
Range(.Cells(5, 5), .Cells(5, 13)).Value = test
End With

Afd = "CCA Logistics"
Set SHMaand = Worksheets("Service Calls Juni")
test = MaandelijksTotaal(Afd, SHMaand)
With Worksheets("Totaal Service Calls")
Range(.Cells(15, 5), .Cells(15, 13)).Value = test
End With

Afd = "CCA Sales"
Set SHMaand = Worksheets("Service Calls Juni")
test = MaandelijksTotaal(Afd, SHMaand)
With Worksheets("Totaal Service Calls")
Range(.Cells(25, 5), .Cells(25, 13)).Value = test
End With

Afd = "Servicedesk"
Set SHMaand = Worksheets("Service Calls Juni")
test = MaandelijksTotaal(Afd, SHMaand)
With Worksheets("Totaal Service Calls")
Range(.Cells(35, 5), .Cells(35, 13)).Value = test
End With

Afd = "CCA Abap"
Set SHMaand = Worksheets("Service Calls Juni")
test = MaandelijksTotaal(Afd, SHMaand)
With Worksheets("Totaal Service Calls")
Range(.Cells(45, 5), .Cells(45, 13)).Value = test
End With

Afd = "CCA Business Warehouse"
Set SHMaand = Worksheets("Service Calls Juni")
test = MaandelijksTotaal(Afd, SHMaand)
With Worksheets("Totaal Service Calls")
Range(.Cells(55, 5), .Cells(55, 13)).Value = test
End With

Afd = "CCA EDI / XML"
Set SHMaand = Worksheets("Service Calls Juni")
test = MaandelijksTotaal(Afd, SHMaand)
With Worksheets("Totaal Service Calls")
Range(.Cells(65, 5), .Cells(65, 13)).Value = test
End With

Afd = "Totaal"
Set SHMaand = Worksheets("Service Calls Juni")
test = MaandelijksTotaal(Afd, SHMaand)
With Worksheets("Totaal Service Calls")
Range(.Cells(75, 5), .Cells(75, 13)).Value = test
End With

End Sub

PLEASE HELP ME OUT I AM STUCK...TO GET THE EXCEL FILE, MESSAGE ME!

 

[m@rio]

Je hoeft je vraag niet in het engels te stellen aangezien dit een nederlands forum is

 

[roortman]

weet ik

Weet ik, maar ik heb hem ook op mr. Excel gezet...
Ik zal trouwens meteen de bijlage even toevoegen...

 

[m@rio]

Je zult de bijlage moeten zippen of rarren aangezien xls extensies niet toegestaan zijn om bijtevoegen en de bijlage mag niet groter zijn dan 100kb

 

[roortman]

bijlage

Dat word dan lastig, ze zijn samen 178Kb gezip op maximum.
nou ja, iemand die de excel sheet wilt hebben, mag me pm'en...

 

[Radagast]

De hardcoded waarden kan je omzeilen door bijvoorbeeld Range("A1").Select te doen. Je moet dan alleen van te voren weten wat daar staat. Dat gaan dan en combinatie van tellen en zoeken worden.
Wat is precies het punt waar je niet uitkomt, want er staat al redelijk wat code?

 

[roortman]

Het echte probleem nader beschreven

Het grootste probleem zit hem in onderstaande, ik heb zoals je begrijpt natuurlijk niet alleen maar juni die ik wil doen. Dit moet een rapportage worden die elke maand gedaan word, dus VB moet zelf weten welke maand het is, die maand selecteren en daar de waarden uithalen en plakken in een ander tabblad op de maand onder de betreffende afdeling.
Als dit werkt komt er nog iets moeilijkers, maar ok...

Sub test()

Dim test As Variant
Dim Afd As String
Dim SHMaand As Worksheet

Afd = "CCA Finance & Controlling / HR"
Set SHMaand = Worksheets("Service Calls Juni")
test = MaandelijksTotaal(Afd, SHMaand)
With Worksheets("Totaal Service Calls")
Range(.Cells(5, 5), .Cells(5, 13)).Value = test
End With

Afd = "CCA Logistics"
Set SHMaand = Worksheets("Service Calls Juni")
test = MaandelijksTotaal(Afd, SHMaand)
With Worksheets("Totaal Service Calls")
Range(.Cells(15, 5), .Cells(15, 13)).Value = test
End With

Afd = "CCA Sales"
Set SHMaand = Worksheets("Service Calls Juni")
test = MaandelijksTotaal(Afd, SHMaand)
With Worksheets("Totaal Service Calls")
Range(.Cells(25, 5), .Cells(25, 13)).Value = test
End With

Afd = "Servicedesk"
Set SHMaand = Worksheets("Service Calls Juni")
test = MaandelijksTotaal(Afd, SHMaand)
With Worksheets("Totaal Service Calls")
Range(.Cells(35, 5), .Cells(35, 13)).Value = test
End With

Afd = "CCA Abap"
Set SHMaand = Worksheets("Service Calls Juni")
test = MaandelijksTotaal(Afd, SHMaand)
With Worksheets("Totaal Service Calls")
Range(.Cells(45, 5), .Cells(45, 13)).Value = test
End With

Afd = "CCA Business Warehouse"
Set SHMaand = Worksheets("Service Calls Juni")
test = MaandelijksTotaal(Afd, SHMaand)
With Worksheets("Totaal Service Calls")
Range(.Cells(55, 5), .Cells(55, 13)).Value = test
End With

Afd = "CCA EDI / XML"
Set SHMaand = Worksheets("Service Calls Juni")
test = MaandelijksTotaal(Afd, SHMaand)
With Worksheets("Totaal Service Calls")
Range(.Cells(65, 5), .Cells(65, 13)).Value = test
End With

Afd = "Totaal"
Set SHMaand = Worksheets("Service Calls Juni")
test = MaandelijksTotaal(Afd, SHMaand)
With Worksheets("Totaal Service Calls")
Range(.Cells(75, 5), .Cells(75, 13)).Value = test
End With

End Sub

 

[jzeedijk]

Hoi Roortman,

Ik heb niet de hele vraag doorgeworsteld, sorry. Je hebt werkbladen met een naam en een maand daar achter. VBA moet de gegevens op het juiste werkblad zeteen afhankelijk van de maand.

Het meest logische lijkt de maand achter naam van het werkblad zetten, maar het kan ook anders.

Set SHMaand = Worksheets("Service Calls Juni")
Als Service Calls Juni het zesde werkblad in je sheet is:
Set SHMaand = Worksheets(6)

Dat werkt hetzelfde en is waarschijnlijk eenvoudiger te realiseren dan het aan elkaar koppelen van teksten.

Jeroen

 

[Withaar]

Even snel wat gemaakt (zie bijlage)
N.b. Ik heb alleen even naar je oorspronkelijke vraag gekeken verder niet naar je code.
Ik ga er vanuit dat je als je nieuwe data voor een maand hebt, een nieuw tabblad (aan het einde) toevoegd en daar je data in plakt.
De macro telt vervolgens de inhoud van de laatste 6 sheets bij elkaar op.
Waarschijnlijk is er ook nog wel een andere manier om achter het laatste tabblad te komen, maar ik kon die nergens vinden, dus heb het maar zo opgelost...

Marco bestaat uit de volgende code.

Sub Macro1()
'
' Macro1 Macro
' De macro is opgenomen op 6-7-2005 door --.

Dim x, y, s
Application.ScreenUpdating = False
'vind laatste sheet
For s = 1 To 100 ' ik ga er vanuit dat er niet meer dan 100 sheets zijn...
On Error GoTo Verder:
Sheets(s).Select
Next s

Verder:
Sheets(1).Select ' Ga naar sheet(1) Het Totaal blad (deze moet ook op positie 1 staan)
s = s - 1 ' het S-de blad wordt niet gevonden dus S-1 bestaat wel
'Cells(1, 1).Value = s 'Aantal tabbladen

'Range van op te tellen cellen
For x = 2 To 4 ' rij 2 t/m 4
For y = 2 To 10 ' kolom B t/m J
Cells(x, y).Value = Worksheets(s - 5).Cells(x, y) + Worksheets(s - 4).Cells(x, y) + Worksheets(s - 3).Cells(x, y) + Worksheets(s - 2).Cells(x, y) + Worksheets(s - 1).Cells(x, y) + Worksheets(s).Cells(x, y)
Next y
Next x

Application.ScreenUpdating = True
End Sub


Let op alle cellen in de range mogen alleen maar getallen bevatten (ook geen spatie, dus schijnbaar leeg zijn!).
Met een extra macro zou je dat even kunnen controleren en eventueel automatisch aanpassen.