AutoFill Formula To The Last Row With Data

**SaburaZera** · 08-21-2014, 06:52 PM

Hello,
I am trying to write a macro which filters columns A and B from ExcelWorkbook1 and copies them into columns A and B in ExcelWorkbook2.
Then, in the ExcelWorkbook2 a new column C is added. C1 = name of the column, C2 = the formula "=LEFT" extracts some text from B2. I want this formula to be autofilled in the whole column C (up to the same row as the column B) but I fail foolishly. I have tried 3 different version of Selection.Autofill but none worked.

The error message is: Run-time error '1004'; Autofill method of Range has failed.
When I degub, the .AutoFill Destination:=Range("C2:C" & Lastrow&) is marked but I can't see any reason for failing.

I would be very glad if you can let me know what I made wrong in my code.
Thank you very much,
SaburaZera

The code:

Code:

Private Sub CommandButton2_Click()

    Set NewBook = Workbooks.Add
        Application.DisplayAlerts = False
            With NewBook
                .Title = "Title"
                .Subject = "Subject"
                .SaveAs Filename:="ExcelWorkbook2" & ".xlsx"
            End With
        Application.DisplayAlerts = True

    ActiveSheet.Select
    ActiveSheet.Name = "Sheet2"
    
'Copy the rows with empty cells in C from ExcelWorkbook1 into ExcekWorkbook2    
    Workbooks("ExcelWorkbook1.xlsm").Activate
    Sheets("Sheet1").Range("A3:D3").Select
    Selection.AutoFilter Field:=3, Criteria1:="="
    
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Workbooks("ExcelWorkbook2.xlsx").Sheets("Sheet1").Activate
    Sheets("Sheet2").Range("A1").Select
    ActiveSheet.Paste

'Delete columns C and D
    Sheets("Sheet2").Columns("C:D").Select
    Selection.ClearContents
    
    Sheets("Sheet2").Columns("B").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Dim Lastrow As Long
    
    Sheets("Sheet2").Range("C1").Select
    ActiveCell.FormulaR1C1 = "Received on"
    Selection.Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],10)"
    ActiveCell.Copy
     
     Lastrow = Worksheets("Sheet2").Range("B2").End(xlDown).Row
        With Worksheets("Sheet2").Range("C2")
            .AutoFill Destination:=Range("C2:C" & Lastrow&)
        End With
        
  
End Sub

**Excel Fox** · 08-22-2014, 05:43 AM

Try this

Code:

Private Sub CommandButton2_Click()

    Dim lngLastRow As Long
    Dim wbkNew As Workbook
    
    Set wbkNew = Workbooks.Add(xlWorksheet)
    With wbkNew
        .Title = "Title"
        .Subject = "Subject"
        .SaveAs Filename:="ExcelWorkbook2" & ".xlsx"
        .Sheets(1).Name = "Sheet2"
    End With
    
    'Copy the rows with empty cells in C from ExcelWorkbook1 into ExcekWorkbook2
    With Workbooks("ExcelWorkbook1.xlsm").Sheets("Sheet1")
        .AutoFilterMode = False
        .Range("A3:D3").AutoFilter Field:=3, Criteria1:="<>"
        lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A3:D" & lngLastRow).Copy wbkNew.Sheets("Sheet2").Range("A1")
    End With


    With wbkNew.Sheets("Sheet2")
        .Columns("C:D").ClearContents 'Clear columns C and D
        lngLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        .Range("B1:B" & lngLastRow).Value = .Range("B1:B" & lngLastRow).Value 'Take out the formulas
        .Range("C1").Value = "Received on"
        .Range("C2:C" & lngLastRow).FormulaR1C1 = "=LEFT(RC[-1],10)"
    End With
  
End Sub