Hi
I get a data extract from a financial database for a couple of years at a time.
The data extract is exported into one excel worksheet. Each extract has many codes. Each code is broken down by 3 sub categories and financial years.
I want to copy the data in the extract and create worksheet naming the worksheets after the codes within the data extract (columnB). Then when these worksheets are created copy the financial data that is to the right (columns e to AH) of column B, column c (sub categories), column d (year) to a defined place in the created worksheet.
I have managed to do this in a half automated way with the code below. What I have to do though is create the worksheets myself and there is a lot! And go down each row of the data extract and press 'ctrl a'
Does anyone have code that would achieve this with a click of a button with comments as I'm pretty new to VBA.
Cheers Michael (my attempt of code below)
Sub aaaPast1()
'
' aaaPast1 Macro
' Macro recorded 31/07/2007 by Michael Peet
'
'v_LE = Application.InputBox("Enter a LE")
'v_Type = Application.InputBox("Enter Type")
'v_tst = Range(v_count).Select
v_crt_row = ActiveCell.Row()
'v_crt_col = ActiveCell.Column()
v_LE_Range = "B" & v_crt_row
v_LE = Trim("LE" & Range(v_LE_Range).Value)
v_ind_Range = "C" & v_crt_row
v_ind = Range(v_ind_Range).Value
v_ind_Range = "D" & v_crt_row
v_year = Range(v_ind_Range).Value
v_Type = v_ind & v_year
'
If v_Type = "ALL2006" Then
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(v_LE).Select
Range("D6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If v_Type = "ALL2007" Then
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(v_LE).Select
Range("D7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If v_Type = "KN2006" Then
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(v_LE).Select
Range("D9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If v_Type = "KN2007" Then
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(v_LE).Select
Range("D10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If v_Type = "RN2006" Then
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(v_LE).Select
Range("D13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If v_Type = "RN2007" Then
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(v_LE).Select
Range("D14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub
Sub looptst()
v_counter = 10
Range("c&v_counter").Select
'Dim Bcell As Range
'For Each Bcell In Range("B1:B175")
'If Range("Bcell").Value = ""
'Next Bcell
End Sub
Sub tst()
For Each n In Range("B2:B19")
If n.Value = "ALL" Then
Range
.Activate
End If
Next n
End Sub
I get a data extract from a financial database for a couple of years at a time.
The data extract is exported into one excel worksheet. Each extract has many codes. Each code is broken down by 3 sub categories and financial years.
I want to copy the data in the extract and create worksheet naming the worksheets after the codes within the data extract (columnB). Then when these worksheets are created copy the financial data that is to the right (columns e to AH) of column B, column c (sub categories), column d (year) to a defined place in the created worksheet.
I have managed to do this in a half automated way with the code below. What I have to do though is create the worksheets myself and there is a lot! And go down each row of the data extract and press 'ctrl a'
Does anyone have code that would achieve this with a click of a button with comments as I'm pretty new to VBA.
Cheers Michael (my attempt of code below)
Sub aaaPast1()
'
' aaaPast1 Macro
' Macro recorded 31/07/2007 by Michael Peet
'
'v_LE = Application.InputBox("Enter a LE")
'v_Type = Application.InputBox("Enter Type")
'v_tst = Range(v_count).Select
v_crt_row = ActiveCell.Row()
'v_crt_col = ActiveCell.Column()
v_LE_Range = "B" & v_crt_row
v_LE = Trim("LE" & Range(v_LE_Range).Value)
v_ind_Range = "C" & v_crt_row
v_ind = Range(v_ind_Range).Value
v_ind_Range = "D" & v_crt_row
v_year = Range(v_ind_Range).Value
v_Type = v_ind & v_year
'
If v_Type = "ALL2006" Then
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(v_LE).Select
Range("D6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If v_Type = "ALL2007" Then
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(v_LE).Select
Range("D7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If v_Type = "KN2006" Then
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(v_LE).Select
Range("D9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If v_Type = "KN2007" Then
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(v_LE).Select
Range("D10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If v_Type = "RN2006" Then
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(v_LE).Select
Range("D13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If v_Type = "RN2007" Then
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(v_LE).Select
Range("D14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub
Sub looptst()
v_counter = 10
Range("c&v_counter").Select
'Dim Bcell As Range
'For Each Bcell In Range("B1:B175")
'If Range("Bcell").Value = ""
'Next Bcell
End Sub
Sub tst()
For Each n In Range("B2:B19")
If n.Value = "ALL" Then
Range
End If
Next n
End Sub