Hjælp til optimering (minimering) af kode (VBA og Excel)

Hej,

Jeg har et beregningsark, hvor jeg udregner priser på nogle kanaler. De kanaler skal så bagefter laves om til posteringsoversigt i .CSV, som jeg kan indlæse i Navision, for at kunne trække statistik på det senere.

Jeg har taget et lille screenshot af en del af beregningssheetet.
Noget er skjult, da det er fortrolige oplysninger. Sorry.
Det kan evt. sendes per mail.

Derudover har jeg lavet lidt makro, som laver opsætningen i et nyt worksheet, som jeg gerne vil have det stillet op, men koden bliver forfærdelig lang.

Kan en eller anden hjælpe med at gøre den kortere/smartere?
Jeg er stadig helt i VBA, så jeg har lidt svært ved at gennemskue en bedre måde at gøre det på.

Opsætning i .CSV:
Vederlagsår;Forbrugsperiode; Programprodukt;Programpakkenummer;Programkode;Tilslutninger;

Makro:
Sub Test_Oplysn()
Worksheets("Posteringstest").Activate
Range("A2").Select
If Range("A2").Value = "" Then
    Range("A2").Activate
Else
    Range("A2").CurrentRegion.Select
    ActiveCell.Offset(Selection.Rows.Count, 0).Activate
End If
If Sheets("XXX TV Basis Q1 2013").Range("A5") >= 0 Then
    With ActiveCell
        .Value = 2013
        .Offset(0, 1).Value = "JANUAR"
        .Offset(0, 2).Value = "BASIS"
        .Offset(0, 3).Value = "1"
        .Offset(0, 3).Activate
    End With
        ActiveCell.Offset(0, 1).Activate
        Sheets("XXX TV Basis Q1 2013").Select
        Range("A5").Select
        Selection.Copy
        Sheets("Posteringstest").Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveCell.Offset(0, 1).Activate
        Sheets("XXX TV Basis Q1 2013").Select
        Range("J4").Select
        Selection.Copy
        Sheets("Posteringstest").Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveCell.Offset(1, -5).Activate
End If
If Sheets("XXX TV Basis Q1 2013").Range("A6") >= 0 Then
    With ActiveCell
        .Value = 2013
        .Offset(0, 1).Value = "JANUAR"
        .Offset(0, 2).Value = "BASIS"
        .Offset(0, 3).Value = "1"
        .Offset(0, 3).Activate
    End With
        ActiveCell.Offset(0, 1).Activate
        Sheets("XXX TV Basis Q1 2013").Select
        Range("A6").Select
        Selection.Copy
        Sheets("Posteringstest").Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveCell.Offset(0, 1).Activate
        Sheets("XXX TV Basis Q1 2013").Select
        Range("J4").Select
        Selection.Copy
        Sheets("Posteringstest").Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveCell.Offset(1, -5).Activate
End If

End Sub