Excel ETL Macro

 

 

Sub McrUpdate()

Application.DisplayAlerts = False
Sheets("Upload").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

Sheets("Upload Form").Select
Columns("A:T").Select
Selection.Copy
Sheets.Add.Name = "Upload"


Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False


Range("A1").Select
ActiveCell.Offset(1, 2).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveSheet.Paste

Dim format1 As Long

For format1 = 1 To 17

ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste

Next

Selection.End(xlUp).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("C2").Select
ActiveSheet.Paste
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.FillDown

Range("D2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Selection.End(xlDown).Select
ActiveCell.Offset(1, -1).Select
ActiveSheet.Paste

Dim format2 As Long

For format2 = 1 To 17

ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Selection.End(xlDown).Select
ActiveCell.Offset(1, -1).Select
ActiveSheet.Paste

Next

Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste

Dim format3 As Long
For format3 = 1 To 17

Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste

Next

Range("B1").Select
Range("B1").Value = "TREASURY_Rate"
Range("C1").Select
Range("C1").Value = "TREASURY_Curve"

Range("C:C").Select
Selection.Cut
Range("B:B").Select
Selection.Insert Shift:=xlToRight

Range("D:Q").Select
Selection.Delete

Columns("A:C").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Columns.AutoFit

'Save as Template for future instances

Application.DisplayAlerts = False

ChDir "M:\Nick\Data Sources\Templates"

ActiveWorkbook.SaveAs Filename:="C:\Users\noswald\Documents\TreasuryTemplate.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

'Save as File Upload

Sheets("Upload Form").Select
ActiveWindow.SelectedSheets.Delete

Sheets("Notes").Select
ActiveWindow.SelectedSheets.Delete

Dim datestr As String

datestr = CStr(Year(Date - Day(Date))) & IIf(Month(Date - Day(Date)) < 10, "0" & CStr(Month(Date - Day(Date))), _
CStr(Month(Date - Day(Date))))

ChDir "C:\Users\noswald\Documents\"

ActiveWorkbook.SaveAs Filename:="C:\Users\noswald\Documents\Treasury" & datestr & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Application.DisplayAlerts = True

'Upload into Access/SQL DB

Dim A As Object
Set A = CreateObject("Access.Application")
A.OpenCurrentDatabase ("C:\Users\noswald\Documents\Data.accdb")
A.DoCmd.runmacro "McrTreasury"
A.Quit

End Sub


Back to Macros

Back to Resume

Back to About Me