[EXCEL] Relatief einde in een range binnen een macro

[Mystikal]

Ik heb onderstaande macro opgenomen.
Ik heb echter het probleem dat de selectie bij cell G1 en H1 stopt op regel 83, terwijl hij moeten kijken naar wat de laatste cel is. Ik heb dit opgenomen door SHIFT+END+Pijltje naar beneden. Echter dat was tijdens het opnemen blijkbaar regel 83, maar inmiddels zijn er meerdere regels.

Het zit ergens in regel 45.

Hetzelfde probleem heb ik met regel 39. Daar stopt de formule bij regel 81. Ik wil hierbij de formule doorkopieeren tot zover de kolom links van cel C en D (dus B ) data heeft. Dit heb ik opgenomen door beiden cellen te selecteren en vervolgens rechtsonder op het kleine 'vierkantje' te drukken. De formule wordt dan naar beneden doorgekopieert.

Iemand suggesties hoe ik dit relatief kan maken?

code:

Sub Trialbalance_Format()
'
' Trialbalance_Format Macro
' Macro recorded 7/2/2009 by ESoeters
'

'
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(13, 1), Array(34, 1), Array(75, 1), Array(94, 1), _
        Array(113, 1)), TrailingMinusNumbers:=True
    Cells.Select
    Cells.EntireColumn.AutoFit
    Rows("1:7").Select
    Range("A7").Activate
    Selection.Delete Shift:=xlUp
    Rows("2:2").Select
    Selection.Delete Shift:=xlUp
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Dept"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Trading"
    Cells.Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("E2").Select
    Selection.End(xlDown).Select
    ActiveCell.Range("A1:A17").Select
    Selection.EntireRow.Delete
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[2],10,4)"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[1],25,4)"
    Range("D3").Select
    ActiveCell.Offset(-1, -1).Range("A1:B1").Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:B81")
    ActiveCell.Range("A1:B81").Select
    Columns("F:H").Select
    Selection.Style = "Comma"
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[2]C:R[82]C)"
    ActiveCell.Select
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy
    Range("H1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Rows("2:2").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.RowHeight = 35.25
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Range("F3").Select
    ActiveWindow.FreezePanes = True
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$2"
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 3
        .PrintErrors = xlPrintErrorsDisplayed
    End With
End Sub

[Reptile209]

Ga eens met deze tips aan de slag. Dat zijn de ctrl-pijl varianten voor in een macro.
Edit:
En probeer in vredesnaam die macro wat op te schonen, want dit is een draak van een ding zo.

[ Voor 27% gewijzigd door Reptile209 op 04-05-2010 21:18 ]