Macro Uitdaging

[M3NGI3]

Geachte experts,

heb de volgende macro opgesteld aan de hand van verschillende macro´s waar ik deeltjes van heb geleend. als het ware een Frankenstein onder de macro´s.
het probleem is dat ie zich ook gedraagt als een Frankstein: ontieglijk langzaam en dodelijk voor de (langzame) server op het werk.

Ik vroeg met af of deze in te korten is?


Public Sub VolgendJaar()

Dim i As String
i = InputBox("Geef aan welk jaar:, 20..")
Bestandsnaam$ = "Regres monitor 20" & i & ".xls"
If i > 0 Then
ActiveWorkbook.SaveAs Bestandsnaam$
Sheets.Select
Columns("A:H").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A1").Select
ActiveCell.FormulaR1C1 = "DOSSIERNUMMER"
Range("B1").Select
ActiveCell.FormulaR1C1 = "VERZEKERDE"
Range("C1").Select
ActiveCell.FormulaR1C1 = "SCHADEDATUM"
Range("D1").Select
ActiveCell.FormulaR1C1 = "BEDRAG INGEDIEND"
Range("E1").Select
ActiveCell.FormulaR1C1 = "ZZZ"
Range("F1").Select
ActiveCell.FormulaR1C1 = "BEDRAG TOEGEKEND"
Range("G1").Select
ActiveCell.FormulaR1C1 = "AFWIJKENDE INFO"
Range("H1").Select
ActiveCell.FormulaR1C1 = "SOORT DEKKING"
Range("I1").Select
Sheets(1).Name = "Januari " & "´" & i
Sheets(2).Name = "Februari " & "´" & i
Sheets(3).Name = "Maart " & "´" & i
Sheets(4).Name = "April " & "´" & i
Sheets(5).Name = "Mei " & "´" & i
Sheets(6).Name = "Juni " & "´" & i
Sheets(7).Name = "Juli " & "´" & i
Sheets(8).Name = "Augustus " & "´" & i
Sheets(9).Name = "September " & "´" & i
Sheets(10).Name = "Oktober" & "´" & i
Sheets(11).Name = "November" & "´" & i
Sheets(12).Name = "December" & "´" & i
Sheets(1).Select
Range("A2").Select
Else: MsgBox ("Geen juiste waarde")
End If
End Sub


Hartelijke ThnQ

 

[276159]

Ik ben ook nog niet lang bezig met VBA, maar wat me hier geleerd is dat dit een stuk korter zou gaan worden:

Public Sub VolgendJaar()

Dim i As String
i = InputBox("Geef aan welk jaar:, 20..")
Bestandsnaam$ = "Regres monitor 20" & i & ".xls"
If i > 0 Then
ActiveWorkbook.SaveAs Bestandsnaam$
Sheets.Select
Columns("A:H").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A1").FormulaR1C1 = "DOSSIERNUMMER"
Range("B1").FormulaR1C1 = "VERZEKERDE"
Range("C1").FormulaR1C1 = "SCHADEDATUM"
Range("D1").FormulaR1C1 = "BEDRAG INGEDIEND"
Range("E1").FormulaR1C1 = "ZZZ"
Range("F1").FormulaR1C1 = "BEDRAG TOEGEKEND"
Range("G1").FormulaR1C1 = "AFWIJKENDE INFO"
Range("H1").FormulaR1C1 = "SOORT DEKKING"
Range("I1").Select
Sheets(1).Name = "Januari " & "´" & i
Sheets(2).Name = "Februari " & "´" & i
Sheets(3).Name = "Maart " & "´" & i
Sheets(4).Name = "April " & "´" & i
Sheets(5).Name = "Mei " & "´" & i
Sheets(6).Name = "Juni " & "´" & i
Sheets(7).Name = "Juli " & "´" & i
Sheets(8).Name = "Augustus " & "´" & i
Sheets(9).Name = "September " & "´" & i
Sheets(10).Name = "Oktober" & "´" & i
Sheets(11).Name = "November" & "´" & i
Sheets(12).Name = "December" & "´" & i
Sheets(1).Select
Range("A2").Select
Else: MsgBox ("Geen juiste waarde")
End If
End Sub

Mocht je dit niet verder helpen, dan kunnen de ervaren rotten hier je waarschijnlijk wel verder helpen

 

[Cobbe]

Public Sub VolgendJaar()

Dim i As String
i = InputBox("Geef aan welk jaar:, 20..")
Bestandsnaam$ = "Regres monitor 20" & i & ".xls"
If i > 0 Then
ActiveWorkbook.SaveAs Bestandsnaam$
Sheets.Select
Columns("A:H").ClearContents
Range("A1").FormulaR1C1 = "DOSSIERNUMMER"
Range("B1").FormulaR1C1 = "VERZEKERDE"
Range("C1").FormulaR1C1 = "SCHADEDATUM"
Range("D1").FormulaR1C1 = "BEDRAG INGEDIEND"
Range("E1").FormulaR1C1 = "ZZZ"
Range("F1").FormulaR1C1 = "BEDRAG TOEGEKEND"
Range("G1").FormulaR1C1 = "AFWIJKENDE INFO"
Range("H1").FormulaR1C1 = "SOORT DEKKING"
Columns("A:H").AutoFit
Sheets(1).Name = "Januari " & "´" & i
Sheets(2).Name = "Februari " & "´" & i
Sheets(3).Name = "Maart " & "´" & i
Sheets(4).Name = "April " & "´" & i
Sheets(5).Name = "Mei " & "´" & i
Sheets(6).Name = "Juni " & "´" & i
Sheets(7).Name = "Juli " & "´" & i
Sheets(8).Name = "Augustus " & "´" & i
Sheets(9).Name = "September " & "´" & i
Sheets(10).Name = "Oktober" & "´" & i
Sheets(11).Name = "November" & "´" & i
Sheets(12).Name = "December" & "´" & i
Sheets(1).Range("A2").Select
Else: MsgBox ("Geen juiste waarde")
End If
End Sub

Zo zijn die 'select' toch al weggewerkt en de kolommen worden automatisch passend(breed genoeg ) gemaakt.

Cobbe

 

[snb]

Public Sub VolgendJaar()
  i = InputBox("Geef aan welk jaar:, 20..")
  If i > 0 Then
    ActiveWorkbook.SaveAs "Regres monitor 20" & i & ".xls"
    With Columns("A:H")
      .ClearContents
      .AutoFit
    End With
    Range("A1:H1") = split("DOSSIERNUMMER|VERZEKERDE|SCHADEDATUM|BEDRAG INGEDIEND|ZZZ|BEDRAG TOEGEKEND|AFWIJKENDE INFO|SOORT DEKKING","|")
    for j=1 to 12
      Sheets(1).Name = format(j,"mmmm '") & i
    Next
  End If
End Sub

 

[M3NGI3]

Public Sub VolgendJaar()
  i = InputBox("Geef aan welk jaar:, 20..")
  If i > 0 Then
    ActiveWorkbook.SaveAs "Regres monitor 20" & i & ".xls"
    With Columns("A:H")
      .ClearContents
      .AutoFit
    End With
    Range("A1:H1") = split("DOSSIERNUMMER|VERZEKERDE|SCHADEDATUM|BEDRAG INGEDIEND|ZZZ|BEDRAG TOEGEKEND|AFWIJKENDE INFO|SOORT DEKKING","|")
    for j=1 to 12
      Sheets(1).Name = format(j,"mmmm '") & i
    Next
  End If
End Sub

Thanx voor de replies iedereen maar de laatste is wel erug kort en zou magisch zijn als deze werkte maar volgens mij pakt deze alleen het actieve of eerste werkblad om de inhoud te wissen en de kolomkoppen aan te passen aan dossiernummer etc....