HWV
Terugkerende gebruiker
- Lid geworden
- 19 feb 2009
- Berichten
- 1.213
Beste,
Ik ben bezig om een overzicht te maken voor de accountmanagers.
Nu heb ik het al voor elkaar om uit het originele bestand de accountmanagers per blad neer te zetten, en dat deze dan in een map onder hun code wordt opgeslagen.
Werkt perfect.
Nu wil ik graag het duidelijker maken en overzichtelijker.
Nu staan de maanden allemaal onder elkaar, ik zou graag de maanden naast elkaar willen zien zodat per klant ik kan zien wie wat heeft gedaan en dan zo van alle klanten onder elkaar. Per omzet en marge (kolom E en K)
In de bijlage mijn bestand, na het draaien van het script om alles weg te zetten per accountmanager.
In de sheet "Voorbeeld na verandering 957" staat hoe ik het graag zou willen hebben en in de scheet "957" hoe ik het nu heb staan.
Heeft iemand een idee hoe ik dit voor elkaar kan krijgen
De gegevens die ik krijg zijn per keer anders, maar wel met de zelfde opmaak en de zelfde accountmanagers (kan ook wel eens veranderen)
Ik exporteer elke keer een jaar, dus de maanden zijn ook variabele
Groet HWV
Formule per blad accountmanager plaatsen en opslaan per accountmanagers nummer in een map
Ik ben bezig om een overzicht te maken voor de accountmanagers.
Nu heb ik het al voor elkaar om uit het originele bestand de accountmanagers per blad neer te zetten, en dat deze dan in een map onder hun code wordt opgeslagen.
Werkt perfect.
Nu wil ik graag het duidelijker maken en overzichtelijker.
Nu staan de maanden allemaal onder elkaar, ik zou graag de maanden naast elkaar willen zien zodat per klant ik kan zien wie wat heeft gedaan en dan zo van alle klanten onder elkaar. Per omzet en marge (kolom E en K)
In de bijlage mijn bestand, na het draaien van het script om alles weg te zetten per accountmanager.
In de sheet "Voorbeeld na verandering 957" staat hoe ik het graag zou willen hebben en in de scheet "957" hoe ik het nu heb staan.
Heeft iemand een idee hoe ik dit voor elkaar kan krijgen
De gegevens die ik krijg zijn per keer anders, maar wel met de zelfde opmaak en de zelfde accountmanagers (kan ook wel eens veranderen)
Ik exporteer elke keer een jaar, dus de maanden zijn ook variabele
Groet HWV
Formule per blad accountmanager plaatsen en opslaan per accountmanagers nummer in een map
Code:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private c4 As Long
Sub begin_omzet()
On Error GoTo Err_Knop1_Click
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
ChDir "D:\test_Omzet"
Workbooks.Open Filename:="D:\test_Omzet\omzet.xls"
Columns(23) = Columns(2).Value
Windows("Omzet per Accountmanager.xls").Activate
Sheets("Opslag").Select
Workbooks("Omzet.xls").Sheets("Data info").Range("A1:W10000").Copy Workbooks("Omzet per Accountmanager.xls").Sheets("Opslag").Range("A1:W10000")
Windows("Omzet per Accountmanager.xls").Activate
Dim c As Range
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim sh As Object
On Error Resume Next
Set ws1 = ThisWorkbook.Worksheets("Opslag")
For Each c In ws1.Range("C2", ws1.Range("C" & Rows.Count).End(xlUp))
If WksExists(c.Text) Then
Set ws = ThisWorkbook.Worksheets(c.Text)
Else
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = c.Text
End If
c.Resize(, 26).Copy ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
Next
ws1.Select
ws1.Columns("aV:aX").Delete
For Each sh In ThisWorkbook.Sheets
If sh.Index > "" Then
Sheets(sh.Name).Select
'' Formule 'aanroepen formule
End If
Next sh
''Application.ScreenUpdating = False
''Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
Sheets(ws.Name).Select
Sheets(ws.Name).Copy
ActiveWorkbook.SaveAs Filename:= _
"D:\test_Omzet\Omzet per accountmanger opslag\" & ws.Name & ".xls", CreateBackup:=False
ActiveWorkbook.Close
ThisWorkbook.Activate
Next
'Workbooks("Omzet.xls").Close SaveChanges:=False
With Sheets("Opslag")
Range("A1:W10000").ClearContents
End With
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
Exit_Knop1_Click:
Exit Sub
Err_Knop1_Click:
MsgBox Err.Description
Resume Exit_Knop1_Click
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function
Laatst bewerkt:
