Find header and copy entire column to the left VBA

Question

My problem is the following.

I have multiple sheets with same tables (prices) for different clients (each sheet is a client). I have to update every day the column of the prices by copying the list prices to the left of the more outdated price.

As an example see the image below:

image1

So I need to copy the last row (z-sprd) and insert to the LEFT of the last date available (in the image below is 6/11/2018). Until now I am able to, loop through the sheets, find the z-sprd column and past it in some place. What I need now is to find the column with the latest price (in this case 6/11/2018) which I did by placing a userform in the sheet, and insert and past the column to its left.

Sub Sample()
    Dim ws As Worksheet
    Dim aCell As Range
    Dim bCell As Range
    Dim col As Long, lRow As Long
    Dim colName As String
    Dim i As Integer

    'Start of the VBA loop
    For i = 1 To Worksheets.Count

    Set ws = ThisWorkbook.Sheets(i)
    'Here i put the latest date, such as 6/11/2018, and then i find it in AC8
    Set bCell = Sheet1.UsedRange.Find(what:=Sheet1.Range("AC8").Value, LookIn:=xlValues, LookAt:=xlWhole, _
                    MatchCase:=False, SearchFormat:=False)
                    bCell.Copy Range("AD8")

    With ws
        Set aCell = .Range("Table").Find(what:="Z-Sprd (bp)", LookIn:=xlValues, LookAt:=xlWhole, _
                    MatchCase:=False, SearchFormat:=False)

    '~~> Copy the entire column
    aCell.EntireColumn.Copy


    '~~> Insert the column here
    With ws
       .Columns("AR:AR").PasteSpecial xlPasteValues
       .Columns("AR:AR").Resize(.Rows.Count - 1, 1).Offset(1, 0).NumberFormat = "0.0"
       bCell.Copy ws.Range("AR7")
       ws.Range("AR7") = ws.Range("AR7") + 7

    End With
    End With

    Next i

End Sub 

Answer 1

The solution I came up with is this one:

Option Explicit


Sub LastPrices()
    Dim ws As Worksheet
    Dim aCell As Range
    Dim bCell As Range
    Dim selrange As Range
    Dim i As Integer
    Dim colnum As Integer, rownum As Integer
    Dim prj As Object
    Dim not_use As Variant


    Set prj = ActiveWorkbook.VBProject
    'Start of the VBA loop

    not_use = Array(2, 7, 8, 9, 10, 11) ' create an array

    For i = 1 To Worksheets.Count
        If IsError(Application.Match(i, not_use, 0)) Then

    Set ws = Worksheets(prj.VBComponents("Sheet" & i).Properties("Index").Value)
    'Set ws = ThisWorkbook.Sheets(i)

    Set bCell = Sheet11.Range("A1")

    With ws
        Set aCell = .Range("Table").Find(what:="Z-Sprd (bp)", LookIn:=xlValues, lookat:=xlWhole, _
                    MatchCase:=False, SearchFormat:=False)

    'look for the row number and column number
    colnum = ws.UsedRange.Find(what:=Sheet11.Range("A1"), lookat:=xlWhole).Column
    rownum = ws.UsedRange.Find(what:=Sheet11.Range("A1"), lookat:=xlWhole).Row

    ws.Columns(colnum).Insert Shift:=xlToRight
    '~~> Copy the entire column
    aCell.EntireColumn.Copy

    'Set the column range to work with
    Set selrange = ws.Columns(colnum)

    '~~> Insert the column here
    With ws
       .Columns(colnum).PasteSpecial xlPasteValues
       .Columns(colnum).Resize(.Rows.Count - 1, 1).Offset(1, 0).NumberFormat = "0.0"
       bCell.Copy ws.Cells(rownum, colnum)
       ws.Cells(rownum, colnum) = ws.Cells(rownum, colnum) + 7

    End With
    End With
    End If
    Next i

End Sub

The code works and now I just have to format the column as to be the same as the other ones. I hope someone will find it helpful. Cheers.