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




Reply With Quote
Bookmarks