Macro to copy & paste value based on File Name

[xstarx]

Hi All,

I'm new to VBA and would need your help on the macro.
I would like to copy and paste values based on the month in the file name.

File Name: Feb 2016
Cell A1 = Jan
Cell B1 = Feb
Cell C1 = Mar
Cell D1 = Apr

Cell U1 = Jan
Cell V1 = Feb
Cell W1 = Mar
Cell X1 = Apr

I would like to copy data in cell A1 to Cell U1 when I open "Feb 2016" file.

Appreciate your inputs on this, thanks!

 

[YasserKhalil]

May be if you jus need to copy A1 only
Put the following code in Workbook_Open

Private Sub Workbook_Open()
    Range("U1").Value = Range("A1").Value
End Sub

Or may be the following

Private Sub Workbook_Open()
    Dim ColA As Integer, ColB As Integer
    On Error Resume Next
    ColA = Application.Match(Mid(ThisWorkbook.Name, 1, 3), Range("A1:D1"), 0)
    ColB = Application.Match(Mid(ThisWorkbook.Name, 1, 3), Range("U1:X1"), 0) + 20
   
    Cells(2, ColB).Value = Cells(2, ColA).Value
End Sub

 

[xstarx]

How do I get the macro to copy and paste previous month instead of the month in the file name?

eg, if my file = Feb 2016, I would like to copy & paste "Jan" data

 

[YasserKhalil]

May be

Private Sub Workbook_Open()
    Dim ColA As Integer, ColB As Integer
    On Error Resume Next
    ColA = Application.Match(Mid(ThisWorkbook.Name, 1, 3), Range("A1:D1"), 0) - 1
    ColB = Application.Match(Mid(ThisWorkbook.Name, 1, 3), Range("U1:X1"), 0) + 19
 
    Cells(2, ColB).Value = Cells(2, ColA).Value
End Sub

 

[xstarx]

Thanks YasserKhalil! How do I replace Workbook Open, with selected sheets? I want to use the macro on multiple selected sheets.

 

[YasserKhalil]

Can you post your sample workbook to be able to get the issue properly?

 

[xstarx]

I would want to use the macro on multiple selected worksheets.

 

[YasserKhalil]

Try this code

Private Sub Workbook_Open()
    Dim SheetArr, SH As Worksheet, I As Integer
    Dim ColA As Integer, ColB As Integer
   
    SheetArr = Array("1", "1 (2)", "1 (3)")
   
    For I = 0 To UBound(SheetArr)
        For Each SH In Sheets
            If SH.Name = SheetArr(I) Then
                With SH
                    On Error Resume Next
                    ColA = Application.Match(Mid(ThisWorkbook.Name, 1, 3), .Range("A1:D1"), 0) - 1
                    ColB = Application.Match(Mid(ThisWorkbook.Name, 1, 3), .Range("U1:X1"), 0) + 19
                    .Cells(2, ColB).Value = .Cells(2, ColA).Value
                End With
            End If
        Next SH
    Next I
End Sub

 

[xstarx]

How do I amend this portion to reflect copy and pasting a range of values? copy data in cell A2:A9 to U2:U9

" .Cells(2, ColB).Value = .Cells(2, ColA).Value"

 

[xstarx]

Please ignore above post.

    ColA = Application.Match(Mid(ThisWorkbook.Name, 6, 3), .Range("d7:o7"), 0) + 2
    ColB = Application.Match(Mid(ThisWorkbook.Name, 6, 3), .Range("ch7:cs7"), 0) + 84

How do I amend the range portion as the match formula is not working due to lookup values format are different?

 

[YasserKhalil]

Try this code in ThisWorkbook module not in standard module

Private Sub Workbook1_Open()
    Dim SheetArr, SH As Worksheet, I As Integer
    Dim ColA As Integer, ColB As Integer
    Dim Cell As Range
   
    SheetArr = Array("1", "1 (2)", "1 (3)")
   
    For I = 0 To UBound(SheetArr)
        For Each SH In Sheets
            If SH.Name = SheetArr(I) Then
                With SH
                    For Each Cell In .Range("D7:O7")
                        If Mid(Cell, 1, 3) = Mid(ThisWorkbook.Name, 6, 3) Then
                            ColA = Cell.Column - 1
                            ColB = ColA + 82
                            .Range(.Cells(8, ColB), .Cells(13, ColB)).Value = .Range(.Cells(8, ColA), .Cells(13, ColA)).Value
                        End If
                    Next Cell
                End With
            End If
        Next SH
    Next I
End Sub

 

[jindon]

To ThisWorkbook Code module

Private Sub Workbook_Open()
    Dim myMonth As String, ws As Worksheet, x
    myMonth = Format$(DateAdd("m", -1, CDate("1 " & Split(Split(Me.Name, "_")(1), ".")(0))), "mmm")
    For Each ws In Worksheets
        x = Application.Match(myMonth, ws.Rows(1), 0)
        If IsNumeric(x) Then ws.Cells(1, x).Resize(9).Copy ws.Cells(1, x + 20)
    Next
End Sub