How to autofill formulas VBA

Question

I am trying ot make a macro that will copy ranges from other reports and put them into one big report. The range copying works fine and does exactly waht it is supposed to. The issue I am having now is how to get the calendar week date (the Monday of the calendar week) using vba. I know of the excel formula to do it but I can't seem to figure out how to implement in vba.

=DATE(Cell with year in it, 1, -2)-WEEKDAY(DATE(Cell with year in it,1,3))+cell with calendar week number (ie calendar week 13)*7

What would be the best way to handle getting the date of the Mondayfor each calendar week?

The current autofill method I tried gives me a run-time error '1004: Autofill method of Range class failed.

Sub BeginHere()
Dim wb As Workbook
Dim ws As Worksheet
Dim wbn As Workbook
Dim wsp As Worksheet
Dim year As String
Dim cw As String
Dim fileName As String
Dim formula As Range

Set wb = ThisWorkbook
Set ws = ActiveSheet

'Test Fulmula
Set formula = ws.Range("p1")

'Last Cell in Destination
Dim lastCellD As Range
'First cell in Destination
Dim firstCellD As Range
'Last Cell in Source
Dim lastCellS As Range
'First Cell in Source
Dim firstCellS As Range

Dim fileDir As String
Dim filePath As String

With Excel.Application
        .ScreenUpdating = False
        .Calculation = Excel.xlCalculationManual
        .EnableEvents = False
        .DisplayAlerts = False
End With

'get the last calendar week from the destination report
Set lastCellD = ws.Range("B7:B7").End(xlDown)
'calculate the next calendar week
cw = lastCellD.formula
cw = cw + 1

'Create file path using PQM directory with the cw and years
fileDir = "file directory here"
filePath = "file name here"    
Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range
Dim r6 As Range, r7 As Range, r8 As Range, r9 As Range, cwr As Range
Dim rm As Range, rdw As Range, ry As Range


'If the next report exist continue processing
If Dir(filePath) <> "" Then
    'Open the source workbook
    Set wbn = Workbooks.Open(filePath)
    fileName = wbn.Name
    year = Mid(fileName, 6, 4)
    'Open the source worksheet
    Set wsp = wbn.Worksheets("Problemliste")

    'Get the cell after the last filled cell in the destination sheet for PQM numbers
    Set lastCellD = ws.Cells(Rows.Count, "C").End(xlUp)

    'Get the first and last cell in the source sheet to get the total number of used cells
    Set firstCellS = wsp.Range("A7")
    Set lastCellS = wsp.Cells(Rows.Count, "A").End(xlUp)

    Set r1 = Range(firstCellS, lastCellS)
    r1.Copy lastCellD.Offset(1, 0)

    Set firstCellS = wsp.Range("B7")
    Set lastCellS = wsp.Cells(Rows.Count, "B").End(xlUp)
    Set r2 = Range(firstCellS, lastCellS)
    r2.Copy lastCellD.Offset(1, 1)

    Set firstCellS = wsp.Range("F7")
    Set lastCellS = wsp.Cells(Rows.Count, "F").End(xlUp)
    Set r3 = Range(firstCellS, lastCellS)
    r3.Copy lastCellD.Offset(1, 2)

    Set firstCellS = wsp.Range("H7")
    Set lastCellS = wsp.Cells(Rows.Count, "H").End(xlUp)
    Set r4 = Range(firstCellS, lastCellS)
    r4.Copy lastCellD.Offset(1, 3)

    Set firstCellS = wsp.Range("J7")
    Set lastCellS = wsp.Cells(Rows.Count, "J").End(xlUp)
    Set r5 = Range(firstCellS, lastCellS)
    r5.Copy lastCellD.Offset(1, 4)

    Set firstCellS = wsp.Range("Y7")
    Set lastCellS = wsp.Cells(Rows.Count, "Y").End(xlUp)
    Set r6 = Range(firstCellS, lastCellS)
    r6.Copy lastCellD.Offset(1, 5)

    Set firstCellS = wsp.Range("AK7")
    Set lastCellS = wsp.Cells(Rows.Count, "AK").End(xlUp)
    Set r7 = Range(firstCellS, lastCellS)
    r7.Copy lastCellD.Offset(1, 6)

    Set firstCellS = wsp.Range("BA7")
    Set lastCellS = wsp.Cells(Rows.Count, "BA").End(xlUp)
    Set r8 = Range(firstCellS, lastCellS)
    r8.Copy lastCellD.Offset(1, 7)

    Set firstCellS = wsp.Range("BE7")
    Set lastCellS = wsp.Cells(Rows.Count, "BE").End(xlUp)
    Set r9 = Range(firstCellS, lastCellS)
    r9.Copy lastCellD.Offset(1, 8)

    'Set firstCellD = last cell in column B
    Set firstCellD = ws.Range("B7").End(xlDown)
    'Offset to get the next empty row
    Set firstCellD = firstCellD.Offset(1, 0)
    'Set lastCellD = the bottom cell of column C
    Set lastCellD = ws.Cells(Rows.Count, "C").End(xlUp)
    'Offset by one column to get target column
    Set lastCellD = lastCellD.Offset(0, -1)
    'Create composit range in targer column
    Set rcw = Range(firstCellD, lastCellD)
    rcw.Value = cw

    'put year in destination sheet
    Set firstCellD = firstCellD.Offset(0, 11)
    Set lastCellD = lastCellD.Offset(0, 11)
    Set ry = Range(firstCellD, lastCellD)
    ry.Value = year

    'get calendar week date
    Set firstCellD = firstCellD.Offset(0, -1)
    Set lastCellD = lastCellD.Offset(0, -1)
    Set rdw = Range(firstCellD, lastCellD)
    'Here is where the error occures
    '********************************************************************
    Range("p1").Autofill Destination:=Range(firstCellD, lastCellD), Type:=xlFillDefailt
    '********************************************************************
    Set firstCellD = firstCellD.Offset(0, -1)
    Set lastCellD = lastCellD.Offset(0, -1)
    Set rm = Range(firstCellD, lastCellD)
    'get month from the calendar week date
    'rm.Formula = datepart(month)


wbn.Close

Else
    MsgBox ("No new file")
End If


End Sub

Answer 1

Instead of using autofill I just put the formula I needed in another sheet, copied the formula to the clipboard, and used pasteSpecial.

ws2.Range("L1").Copy
rdw.PasteSpecial (xlPasteAll)

Answer 2

According to the MSDN, Autofill requires that the source be part of the destination (https://stackoverflow.com/a/1528853/2832561)

Looking back through your code...

Set firstCellD = ws.Range("B7").End(xlDown)
'Offset to get the next empty row
Set firstCellD = firstCellD.Offset(1, 0)
'Set lastCellD = the bottom cell of column C
Set lastCellD = ws.Cells(Rows.Count, "C").End(xlUp)
'Offset by one column to get target column
Set lastCellD = lastCellD.Offset(0, -1)
'Create composit range in targer column
Set rcw = Range(firstCellD, lastCellD)
rcw.Value = cw

After the above, both firstCellD and lastCellD are in column "B".

'put year in destination sheet
Set firstCellD = firstCellD.Offset(0, 11)
Set lastCellD = lastCellD.Offset(0, 11)
Set ry = Range(firstCellD, lastCellD)
ry.Value = year

Here, they are offset to column "N".

'get calendar week date
Set firstCellD = firstCellD.Offset(0, -1)
Set lastCellD = lastCellD.Offset(0, -1)
Set rdw = Range(firstCellD, lastCellD)
'Here is where the error occures
'********************************************************************
Range("p1").Autofill Destination:=Range(firstCellD, lastCellD), Type:=xlFillDefailt
'********************************************************************
Set firstCellD = firstCellD.Offset(0, -1)
Set lastCellD = lastCellD.Offset(0, -1)
Set rm = Range(firstCellD, lastCellD)
'get month from the calendar week date
'rm.Formula = datepart(month)

Right before the error, they are offset again, one column to the left: "M". Because "P1" is not in the range in column "M", the Autofill function fails.

---

I suggest instead copying the formula to firstCellD, then using that as the source for the Autofill, assuming that the formula in "P1" uses appropriate relative addressing.

TL;DR & Response to Comment:

What your code is currently doing is trying to Autofill a formula from "P1" into the range of cells in column "M" as defined by Range(firstCellD, lastCellD). This doesn't work because Autofill requires the source cell(s) of the fill to be part of the destination range, just as if you were to do it manually by dragging the fill handle in the lower right-hand corner of a cell. If the formula in "P1" is truly what should be populated into the specified cells of column "M", you should first copy the formula over to firstCellD, then perform the Autofill from firstCellD to the rest of the range. The two lines of code that would do this are:

Range("P1").Copy firstCellD
firstCellD.Autofill Destination:=Range(firstCellD, lastCellD), Type:=xlFillDefault

Make a backup copy of your Excel doc and give it a try!