Macro to change database format.

[Esrei]

I want this macro to, after it have inserted the colmns and added the formula
(see below) to
1. copy range A1 to E1 to every row where the word "Header" is in colmn F.
2. Then copy paste the whole sheet as values. (This I can do)
3. Then the range now standing left of "header" must be copied to the empy
cells beneath each heading.


Range A1:E1 must be coppied to A2:E2 but range A3:E3 must be coppied to A4:E5
and so on. But this is not set

I am trying to rewrite a database export in a readble sortable format, but
my konledge of VB is limited.
Please help

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 09/12/2005 by Nadia
'

'
Columns("A:E").Select
Selection.Insert Shift:=xlToRight
Range("A1").Select
ActiveCell.FormulaR1C1 = "=RC[6]"
Range("B1").Select
ActiveCell.FormulaR1C1 = "=RC[8]"
Range("C1").Select
ActiveCell.FormulaR1C1 = "=RC[8]"
Range("D1").Select
ActiveCell.FormulaR1C1 = "=RC[8]"
Range("E1").Select
ActiveCell.FormulaR1C1 = "=RC[8]"
Range("A2").Select
Dim LastRow As Long
Dim row_index As Long
Application.ScreenUpdating = False
LastRow = ActiveSheet.Cells(Rows.Count, "F").End(xlUp).Row
For row_index = LastRow - 1 To 2 Step -1
If Cells(row_index, "F").Value = "Header" Then
Rows(1).Copy Destination:=Rows(row_index + 1)
End If
Next


Thanks

[Tom Ogilvy]

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 09/12/2005 by Nadia
'

'
Dim rng as Range, rng1 as Range
Columns("A:E").Select
Selection.Insert Shift:=xlToRight
Range("A1").FormulaR1C1 = "=RC[6]"
Range("B1").FormulaR1C1 = "=RC[8]"
Range("C1").FormulaR1C1 = "=RC[8]"
Range("D1").FormulaR1C1 = "=RC[8]"
Range("E1").FormulaR1C1 = "=RC[8]"
Range("A2").Select
Dim LastRow As Long
Dim row_index As Long
Application.ScreenUpdating = False
LastRow = ActiveSheet.Cells(Rows.Count, "F").End(xlUp).Row
For row_index = LastRow - 1 To 2 Step -1
If Cells(row_index, "F").Value = "Header" Then
Range("A1:E1").Copy Destination:=Cells(row_index,1)
End If
Next
Columns("A:E").Copy
Columns("A:E").PasteSpecial xlValues
set rng = Range("A1:E" & LastRow)
On Error Resume Next
set rng1 = rng.specialCells(xlblanks)
On Error goto 0
if not rng1 is nothing then
rng1.formula = "=" & rng1(1).offset(-1,0).Address(0,0)
rng.copy
rng.pasteSpecial xlValue
End if
End sub

--
Regards,
Tom Ogilvy


"Esrei" <Esrei@discussions.microsoft.com> wrote in message
news:EC88A9AF-CD12-4EA6-B96C-DC63A7133876@microsoft.com...
> I want this macro to, after it have inserted the colmns and added the
formula
> (see below) to
> 1. copy range A1 to E1 to every row where the word "Header" is in colmn F.
> 2. Then copy paste the whole sheet as values. (This I can do)
> 3. Then the range now standing left of "header" must be copied to the empy
> cells beneath each heading.
>
>
> Range A1:E1 must be coppied to A2:E2 but range A3:E3 must be coppied to
A4:E5
> and so on. But this is not set
>
> I am trying to rewrite a database export in a readble sortable format, but
> my konledge of VB is limited.
> Please help
>
> Sub Macro1()
> '
> ' Macro1 Macro
> ' Macro recorded 09/12/2005 by Nadia
> '
>
> '
> Columns("A:E").Select
> Selection.Insert Shift:=xlToRight
> Range("A1").Select
> ActiveCell.FormulaR1C1 = "=RC[6]"
> Range("B1").Select
> ActiveCell.FormulaR1C1 = "=RC[8]"
> Range("C1").Select
> ActiveCell.FormulaR1C1 = "=RC[8]"
> Range("D1").Select
> ActiveCell.FormulaR1C1 = "=RC[8]"
> Range("E1").Select
> ActiveCell.FormulaR1C1 = "=RC[8]"
> Range("A2").Select
> Dim LastRow As Long
> Dim row_index As Long
> Application.ScreenUpdating = False
> LastRow = ActiveSheet.Cells(Rows.Count, "F").End(xlUp).Row
> For row_index = LastRow - 1 To 2 Step -1
> If Cells(row_index, "F").Value = "Header" Then
> Rows(1).Copy Destination:=Rows(row_index + 1)
> End If
> Next
>
>
> Thanks
>

[Esrei]

Works like a charm.

"Tom Ogilvy" wrote:

> Sub Macro1()
> '
> ' Macro1 Macro
> ' Macro recorded 09/12/2005 by Nadia
> '
>
> '
> Dim rng as Range, rng1 as Range
> Columns("A:E").Select
> Selection.Insert Shift:=xlToRight
> Range("A1").FormulaR1C1 = "=RC[6]"
> Range("B1").FormulaR1C1 = "=RC[8]"
> Range("C1").FormulaR1C1 = "=RC[8]"
> Range("D1").FormulaR1C1 = "=RC[8]"
> Range("E1").FormulaR1C1 = "=RC[8]"
> Range("A2").Select
> Dim LastRow As Long
> Dim row_index As Long
> Application.ScreenUpdating = False
> LastRow = ActiveSheet.Cells(Rows.Count, "F").End(xlUp).Row
> For row_index = LastRow - 1 To 2 Step -1
> If Cells(row_index, "F").Value = "Header" Then
> Range("A1:E1").Copy Destination:=Cells(row_index,1)
> End If
> Next
> Columns("A:E").Copy
> Columns("A:E").PasteSpecial xlValues
> set rng = Range("A1:E" & LastRow)
> On Error Resume Next
> set rng1 = rng.specialCells(xlblanks)
> On Error goto 0
> if not rng1 is nothing then
> rng1.formula = "=" & rng1(1).offset(-1,0).Address(0,0)
> rng.copy
> rng.pasteSpecial xlValue
> End if
> End sub
>
> --
> Regards,
> Tom Ogilvy
>
>
> "Esrei" <Esrei@discussions.microsoft.com> wrote in message
> news:EC88A9AF-CD12-4EA6-B96C-DC63A7133876@microsoft.com...
> > I want this macro to, after it have inserted the colmns and added the
> formula
> > (see below) to
> > 1. copy range A1 to E1 to every row where the word "Header" is in colmn F.
> > 2. Then copy paste the whole sheet as values. (This I can do)
> > 3. Then the range now standing left of "header" must be copied to the empy
> > cells beneath each heading.
> >
> >
> > Range A1:E1 must be coppied to A2:E2 but range A3:E3 must be coppied to
> A4:E5
> > and so on. But this is not set
> >
> > I am trying to rewrite a database export in a readble sortable format, but
> > my konledge of VB is limited.
> > Please help
> >
> > Sub Macro1()
> > '
> > ' Macro1 Macro
> > ' Macro recorded 09/12/2005 by Nadia
> > '
> >
> > '
> > Columns("A:E").Select
> > Selection.Insert Shift:=xlToRight
> > Range("A1").Select
> > ActiveCell.FormulaR1C1 = "=RC[6]"
> > Range("B1").Select
> > ActiveCell.FormulaR1C1 = "=RC[8]"
> > Range("C1").Select
> > ActiveCell.FormulaR1C1 = "=RC[8]"
> > Range("D1").Select
> > ActiveCell.FormulaR1C1 = "=RC[8]"
> > Range("E1").Select
> > ActiveCell.FormulaR1C1 = "=RC[8]"
> > Range("A2").Select
> > Dim LastRow As Long
> > Dim row_index As Long
> > Application.ScreenUpdating = False
> > LastRow = ActiveSheet.Cells(Rows.Count, "F").End(xlUp).Row
> > For row_index = LastRow - 1 To 2 Step -1
> > If Cells(row_index, "F").Value = "Header" Then
> > Rows(1).Copy Destination:=Rows(row_index + 1)
> > End If
> > Next
> >
> >
> > Thanks
> >
>
>
>