Autofill in functie van wat in kolom A staat

[Visus]

Autofill probleem met bestand met slechts 1 of 2 regels

Op basis van voorgaande heb ik onderstaande code geschreven en dat werkt in bestanden waar meer dan twee regels staan. Nu komen er bij mij soms bestanden voor met slechts twee regels, de kopregel en één regel met gegevens. Zoals in onderstaande code te zien is het de bedoeling om alle regels aan te vullen met titels in de kopregel AN1, AO1 en AP1 en vervolgens tekst te typen in AN2 en formules in AO2 en AP2. Daarna moeten deze drie cellen met autofill doorggetrokken worden voor alle gevulde regels in de kolommen A t/m AM. Dat gaat goed bij bestanden met méér dan één regel met gegevens, maar de macro gaat de fout in bij één regel.

Weet iemand een oplossing?
Groet Visus


Sub Totaal()
'
' Openen_toevoegen Macro
' De macro is opgenomen op 16-11-2009 door .


'OPEN het bestand 31000
Workbooks.Open Filename:= _
"J:\31000.xls"
ActiveWindow.ScrollColumn = 28

Dim lr As Integer
lr = Columns(16).Cells(Rows.Count).End(xlUp).Row

'HERNOEM tabblad in 31000
For Each sh In Sheets
sh.Name = "31000"
Next
'SELECTEER cel AN1 en type AA
Range("AN1").Select
ActiveCell.FormulaR1C1 = "AA"
'SELECTEER CEL AO1 en type leeftijd
Range("AO1").Select
ActiveCell.FormulaR1C1 = "Leeftijd"
'SELECTEER cel AP1 en type DOORLOOP
Range("AP1").Select
ActiveCell.FormulaR1C1 = "Doorloop"
'SELECTEER cel AN2 en type AB
Range("AN2").Select
ActiveCell.FormulaR1C1 = "AB"
'SELECTEER cel AO2 en type bereken LEEFTIJD
Range("AO2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-6]="""","""",DATEDIF(RC[-6],RC[-38],""y""))"
Range("AO2").Select
'SELECTEER cel AP2 en bereken DOORLOOP
Range("AP2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-33]="""","""",TODAY()-RC[-33])"

'Autofill van de 3 formules hierboven
Range("AN2:AP2").AutoFill Range("AN2:AP" & lr), xlFillDefault

'Sluit bestand 31000
ActiveWorkbook.SaveAs Filename:= _
"J:\31000.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close

 

[snb]

En maak er ook nog even VBA van.

Sub Totaal()
  Workbooks.Open "J:\31000.xls"
  With ActiveWorkbook
    With .sheets(1)
      .name="31000"
      .[AN1].resize(,3)=split("AA|Leeftijd|Doorloop","|")
      .[AN2].resize(,3)=split("AB|=IF(AI2="","",Datadif(AI2,C3,"y"))|=IF(G2="","",Today()-G2)","|")
      with .cells(rows.count,16).end(xlup)
        if .row >2 then activeworkbook.sheets(1).[AN2:AP2].resize(.row).filldown
      end with
    with 
   .Close true
  End with
End Sub

 

[Visus]

snb bedankt voor je reactie en het enorm inkorten van de code maar deze bleek bij mij niet te werken. In eerste instantie kreeg ik een foutmelding op de regel .AN2. Deze was na kopieren ook anders gekleurd.Toen ik daar wat spaties had gewijzigd werkte e.e.a. wel maar werd alleen de formule in de cellen opgenomen, niet het resultaat. Ook werd de foutmelding gegeven dan bij "y" een ) werd verwacht. Heb ik wat verkeerd gedaan?

Groet

Visus

 

[Warme bakkertje]

Sub Totaal()
  Workbooks.Open "J:\31000.xls"
  With ActiveWorkbook
    With .Sheets(1)
      .Name = "31000"
      .[AN1].Resize(, 3) = Split("AA|Leeftijd|Doorloop", "|")
      .[AN2].Resize(, 3) = Split("AB|=IF(AI2="""","""",Datadif(AI2,C3,""y""))|=IF(G2="""","""",Today()-G2)", "|")
      With .Cells(Rows.Count, 16).End(xlUp)
        If .Row > 2 Then ActiveWorkbook.Sheets(1).[AN2:AP2].Resize(.Row).FillDown
      End With
    End With
   .Close True
  End With
End Sub

Normaal gezien zou hij het zo moeten doen. Er ontbraken enkel wat aanhalingstekens in de formules.

 

[Visus]

Helaas,

Nu ook alleen maar de tekst van de formule in de cellen AO en AP en niet het resultaat van de forules.

OA2 staat =IF(AI2="","",Datadif(AI2,C3,"y"))
AP2 staat =IF(G2="","",Today()-G2)

 

[snb]

Sub Totaal()
  Workbooks.Open "J:\31000.xls"
  With ActiveWorkbook
    With .sheets(1)
      .name="31000"
      .[AN1].resize(,3)=split("AA|Leeftijd|Doorloop","|")
      .[AN2].Resize(, 3) = Split(Replace("AB|=Als(AI2=^^;^^;Datadif(AI2;C3;^y^))|=Als(G2=^^;^^;vandaag()-G2)", "^", Chr(34)), "|")
      .[AN2].Resize(, 3) = .[AN2].Resize(, 3).Value

      with .cells(rows.count,16).end(xlup)
        if .row >2 then activeworkbook.sheets(1).[AN2:AP2].resize(.row).filldown
      end with
    with 
   .Close true
  End with
End Sub

 

[Visus]

Nu loopt hij vast op deze regel ???

.[AN2].Resize(, 3) = [AN2].Resize(, 3).Value

 

[snb]

Kijk dan eens goed waar de punt in deze regel ontbreekt.
En werk niet met code die je niet begrijpt.

 

[Visus]

Sorry, ik ben nog maar een beginner met VBA en ik heb geprobeerd op de punt ergens neer te zetten maar dat werkt niet. Ik denk dat ik wel begrijp wat de code doet, alleen weet ik niet precies waar de punt moet komen.