Urenlijst in excel met macro's

[anoniem]

Hallo, Op dit moment ben ik bezig met een urenlijst te maken voor 2004 in excel. Ik ben al best ver, maar ik heb wat vraagjes over macro's. * Hoe kan ik werkbladen kopieren met een macro zodat de naam van het werkblad een nummer verhoogt. Ik heb nu de volgende code: [code:1:db6625f481] Sub Macro1() ' ' Macro1 Macro ' ' Sneltoets: CTRL+SHIFT+L ' Sheets("4").Select Sheets("4").Copy After:=Sheets(55) End Sub [/code:1:db6625f481] Deze code kopieert het werkblad wel, maar de naam van het blad wordt dan bijvoorbeeld 4 (2), 5 (2) enz... Ik kopieer deze macro een aantal keren achter elkaar en voer hem dan vervolgens uit. Computer is dan aardig flink aan het rekenen, maar het gaat wel automatisch. De sheets stellen de weken van het jaar dus voor. Dus in 2004 53 weken. Ik wil week 1 52x kopiëren zodat ik 53 weken heb. * Verder heb ik gebruik ik 2 andere excelbestanden. Eentje voor de klantcodes en de andere voor aktiviteitcodes. De gegevens worden bij het kopieren van een werkblad bijgewerkt. Dat kost zee-en van tijd. Kan ik dat uitschakelen zodat het kopiëren sneller gaat. * Kan ik ook die gegevens (met name klantenlijst) uit het excelbestand verwijderen, want ik wil het bestand wellicht delen met andere mensen. Hopelijk kan iemand me helpen. Verder zit ik eraan te denken de urenlijst online te zetten. Ik heb al 'n afschrijvingsstaat, dus als iemand interesse heeft kan me mailen.

[anoniem]

Hallo, met het copieren kan ik je wel helpen. Ik ga ervanuit dat je 1 blad heb en dat deze ook nog eens 1 heet. Anders moet je het een en ander maar even wijzigen in de code: [code:1:f7c8e6835b]For i = 1 To 52 Sheets(i).Select Sheets(i).Copy after:=Sheets(i) Sheets(i + 1).Name = i + 1 Next i[/code:1:f7c8e6835b] Dit is eigenlijk alles. For en next zorgen ervoor dat het copieren 52x gedaan worden. Sheets(i).Copy after:=Sheets(i) zorgt ervoor dat het geselecteerde blad gekopieerd wordt en achter het geselecteerde blad geplaatst wordt. Sheets(i + 1).Name = i + 1 zorgt ervoor dat het blad een nummer krijgt die 1 hoger is. Groeten, Wouter

[anoniem]

Voor uw eerste vraag: [code:1:6c3b29b579] Public Sub CopyActiveSheet() Dim shtHighestNumber As Integer shtHighestNumber = CStr(HighestSheetNumber) + 1 ActiveSheet.Copy After:=Worksheets(Worksheets.Count) ActiveSheet.Name = shtHighestNumber End Sub ' Public Function HighestSheetNumber() As Integer Dim sht As Worksheet Dim iSheetNumber As Integer HighestSheetNumber = 0 For Each sht In ActiveWorkbook.Worksheets On Error Resume Next iSheetNumber = CInt(ActiveSheet.Name) If (Err.Number = 0) And (iSheetNumber > HighestSheetNumber) Then HighestSheetNumber = iSheetNumber End If Next sht End Function [/code:1:6c3b29b579]

[anoniem]

Oeps, een klein foutje op lijn 4: [code:1:6a6e2a45d0] shtHighestNumber = CStr(HighestSheetNumber + 1) [/code:1:6a6e2a45d0] Wanneer uw actieve werkblad (dat wordt gekopiëerd) geen numerieke naam heeft, zal deze functie zelf aan het nieuwe werkblad een numerieke waarde toekennen die één hoger ligt dan de hoogstgenummerde werkbladnaam in uw werkboek. U kunt deze procedure desgewenst in een lus plaatsen, ofwel toekennen aan een sneltoets.

[anoniem]

Voor uw tweede vraag, in verband met het 'versnellen' van het uitvoeren, kunt u de volgende code plaatsen vóór het uitvoeren: [code:1:a19780d66c] Application.ScreenUpdating = False [/code:1:a19780d66c] ... en ná de uitvoerende code: [code:1:a19780d66c] Application.ScreenUpdating = True [/code:1:a19780d66c] U zal zien dat het een hemelsbreed verschil geeft qua uitvoeringstijd.

[anoniem]

Bedankt voor de tips. Sorry, voor maar late reactie. Helaas kom ik er nog niet helemaal uit. De code van E. Cle werkt wel. Alleen werd de sheet 1 keer gekopieerd. Dus ik heb de 52 xcode gekopieerd, maar toen krijg ik de melding dat een variabele ongeldig was. Het lukt me niet om in een korte tijd zelf die for-lus op te stellen in combinatie met de andere code. Urenlijst moet vandaag helaas al af zijn. De code van E. Clde bestaat uit 2 functies toch? Of is Public Function HighestSheetNumber() As Integer een onderdeel van CopyActiveSheet? [code:1:01a0e400fd] Application.ScreenUpdating = False Public Sub CopyActiveSheet() Dim shtHighestNumber As Integer shtHighestNumber = CStr(HighestSheetNumber + 1) ActiveSheet.Copy After:=Worksheets(Worksheets.Count) ActiveSheet.Name = shtHighestNumber End Sub ' Public Function HighestSheetNumber() As Integer Dim sht As Worksheet Dim iSheetNumber As Integer HighestSheetNumber = 0 For Each sht In ActiveWorkbook.Worksheets On Error Resume Next iSheetNumber = CInt(ActiveSheet.Name) If (Err.Number = 0) And (iSheetNumber > HighestSheetNumber) Then HighestSheetNumber = iSheetNumber End If Next sht End Function Application.ScreenUpdating = True [/code:1:01a0e400fd] Doe ik iets verkeerd? Klopt die apastrofe trouewns na End Sub? Dat zijn toch opmerkingtekens? Hopelijk kan iemand me ff helpen...

[anoniem]

Voilà, hier heb je het gehele programma: [code:1:aa6463709a] Option Explicit ' Public Sub Copy52() Dim i As Integer Application.ScreenUpdating = False For i = 1 To 52 CopyActiveSheet Next i Application.ScreenUpdating = True End Sub ' Private Sub CopyActiveSheet() Dim strHighestNumber As String strHighestNumber = CStr(HighestSheetNumber + 1) ActiveSheet.Copy After:=Worksheets(Worksheets.Count) ActiveSheet.Name = strHighestNumber End Sub ' Private Function HighestSheetNumber() As Integer Dim sht As Worksheet Dim iSheetNumber As Integer HighestSheetNumber = 0 For Each sht In ActiveWorkbook.Worksheets On Error Resume Next iSheetNumber = CInt(ActiveSheet.Name) If (Err.Number = 0) And (iSheetNumber > HighestSheetNumber) Then HighestSheetNumber = iSheetNumber End If Next sht End Function [/code:1:aa6463709a] Creëer een lege module, kopieer deze code daarin, en voer uit...

[anoniem]

Bedankt voor de code. De urenlijst is in gebruik genomen. Het was wel een stuk makkelijker door de macro. Heeft me een hoop werk gescheeld. Verder wen ik me aan om meer macro's te maken op m'n werk,want het scheelttoch tijd. Met de optie "Macro opnemen" kan je toch 'n hoop leren. Thuis gebruik ik voornamelijk OpenOffice. Dat werkt geloof ik weer heel anderes. Excel is toch Visual Basis for Applications? Als iemand interesse heeft in een lege urenlijst dan kan je me een bericht sturen.