I have a number of files, it contains data of each and every day of a month.
I need to collect all the data to a master file and insert date for each file.
I set [the 1st day -1] in A1 cell and use the code below to set date to each day range but it is not working well. Any helps is appreciated!
Do While buf <> ""
Set openWB = Workbooks.Open(fold_path & "\" & buf)
With openWB.ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, "A"), .Cells(LastRow, LastCol)).Copy
End With
With ThisWorkbook.Worksheets("GA")
.Range("B" & .Cells(.Rows.Count, "B").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Range(.Cells(Cells(.Rows.Count, "B").End(xlUp).Row, "A"), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row + 1, "A")).Value = .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, "A").Value + 1
End With
openWB.Close False
buf = Dir()　Loop
Try it this way:
With ThisWorkbook.Worksheets("GA")
With .Cells(.Rows.count, "B").End(xlUp).Offset(1)
.Offset(, -1).value = .Offset(, -1).End(xlUp).value + 1
.PasteSpecial Paste:=xlPasteValues
End With
End With
Related
The VBA as seems to be glitchy (screen view jumps back and forth) and does not end back on the userform. Is there a way to refine the VBA to work better? and is there another way to place the row in a specific row on a worksheet?
Excel VBA - using userform and datasheet (workbook A). After inputting a number in up to 8 different textboxes on a userform. The textbox is linked to a datasheet. the vba gets the number from the datasheet and searches another workbook (Workbook B) for the number in Column A. After found it will copy and paste to a row on the sheet on (workbook a). the sequence will continue for the next textbox and the next etc.
Private Sub CommandButton83_Click()
Dim LastRow As Integer, i As Integer, erow As Integer
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1).Value = TextBox192.Value Then
Range(Cells(i, 1), Cells(i, 25)).Select
Selection.Copy
Workbooks.Open Filename:="C:location"
Workbooks("MainWorkBook").Worksheets("PatientData").Activate
Worksheets("PatientData").Select
ActiveSheet.Cells(3, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If
Next i
Workbooks("Workbook2").Worksheets("Roll Call").Activate
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1).Value = TextBox193.Value Then
Range(Cells(i, 1), Cells(i, 25)).Select
Selection.Copy
Workbooks.Open Filename:="C:location"
Workbooks("MainWorkBook").Worksheets("PatientData").Activate
Worksheets("PatientData").Select
ActiveSheet.Cells(5, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Application.CutCopyMode = False
End If
Next i
Workbooks("Workbook2").Worksheets("Roll Call").Activate
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1).Value = TextBox194.Value Then
Range(Cells(i, 1), Cells(i, 25)).Select
Selection.Copy
Workbooks.Open Filename:="C:location"
Workbooks("MainWorkBook").Worksheets("PatientData").Activate
Worksheets("PatientData").Select
ActiveSheet.Cells(7, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Application.CutCopyMode = False
End If
Next i
Workbooks("Workbook2").Worksheets("Roll Call").Activate
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1).Value = TextBox195.Value Then
Range(Cells(i, 1), Cells(i, 25)).Select
Selection.Copy
Workbooks.Open Filename:="C:\location"
Workbooks("MainWorkBook").Worksheets("PatientData").Activate
Worksheets("PatientData").Select
ActiveSheet.Cells(9, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Application.CutCopyMode = False
End If
Next i
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1).Value = TextBox196.Value Then
Range(Cells(i, 1), Cells(i, 25)).Select
Selection.Copy
Workbooks.Open Filename:="C:Location of file"
Workbooks("MainWorkBook").Worksheets("PatientData").Activate
Worksheets("PatientData").Select
ActiveSheet.Cells(11, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Application.CutCopyMode = False
End If
Next i
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1).Value = TextBox197.Value Then
Range(Cells(i, 1), Cells(i, 25)).Select
Selection.Copy
Workbooks.Open Filename:="C:Location"
Workbooks("MainWorkBook").Worksheets("PatientData").Activate
Worksheets("PatientData").Select
ActiveSheet.Cells(13, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If
Next i
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1).Value = TextBox198.Value Then
Range(Cells(i, 1), Cells(i, 25)).Select
Selection.Copy
Workbooks.Open Filename:="C:location"
Workbooks("MainWorkBook").Worksheets("PatientData").Activate
Worksheets("PatientData").Select
ActiveSheet.Cells(15, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Application.CutCopyMode = False
End If
Next i
If OptionButton65.Value = True Then
Workbooks("Workbook2").Worksheets("Roll Call").Activate
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1).Value = TextBox199.Value Then
Range(Cells(i, 1), Cells(i, 25)).Select
Selection.Copy
Workbooks.Open Filename:="C:location"
Workbooks("MainWorkBook").Worksheets("PatientData").Activate
Worksheets("PatientData").Select
ActiveSheet.Cells(17, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
Application.CutCopyMode = False
End If
Next i
End Sub
'Being able to refine the VBA to single function of looking for number provided in a textbox (which will change on every use) on a closed/open workbook and copy the row that matches the number onto the userform workbook in a specific row. Only as many as eight rows will be copied per use but mor than likely three will be used. So not all textboxes will have data entered every time.
The VBA as seems to be glitchy (screen view jumps back and forth)
The immediate answer to removing the 'glitchy' behaviour is to avoid using Select and Activate. For example:
How to avoid using Select in Excel VBA
Excel 2013 VBA alternative to using Activate and Select
Also - indenting the code properly helps with readability, maintenance and bug finding.
Finally. Add Option Explicit to the top of the module containing code. Always.
Private Sub CommandButton83_Click()
Dim c As Range
Dim d As Range, u As Range, o As Range, p As Range, q As Range, r As Range, _
s As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Dim Outcome As Worksheet
Application.Workbooks.Open Filename:="C:\Users\Desktop\Workbook1.xml"
Application.ScreenUpdating = False
Set Source = Application.Workbooks("WorkBook1").Worksheets("Sheet1")
Set Target = ThisWorkbook.Worksheets("DataSheet")
Set Outcome = ThisWorkbook.Worksheets("Data")
For Each c In Source.Range("A3:A" & Source.Cells(Rows.Count, "A").End(xlUp).Row)
j = Outcome.Cells(Rows.Count, 3).End(xlUp).Row + 1
If c = TextBox192.Value Then Outcome.Rows(j).Value = Source.Rows(c.Row).Value
Next c
For Each d In Source.Range("A1:A" & Source.Cells(Rows.Count, "A").End(xlUp).Row)
j = Outcome.Cells(Rows.Count, 3).End(xlUp).Row + 1
If d = TextBox193.Value Then Outcome.Rows(j).Value = Source.Rows(d.Row).Value
Next d
For Each n In Source.Range("A1:A" & Source.Cells(Rows.Count, "A").End(xlUp).Row)
j = Outcome.Cells(Rows.Count, 3).End(xlUp).Row + 1
If n = TextBox194.Value Then Outcome.Rows(j).Value = Source.Rows(n.Row).Value
Next n
For Each o In Source.Range("A1:A" & Source.Cells(Rows.Count, "A").End(xlUp).Row)
j = Outcome.Cells(Rows.Count, 3).End(xlUp).Row + 1
If o = TextBox195.Value Then Outcome.Rows(j).Value = Source.Rows _
(o.Row).Value
Next o
For Each p In Source.Range("A1:A" & Source.Cells(Rows.Count, "A").End(xlUp).Row)
j = Outcome.Cells(Rows.Count, 3).End(xlUp).Row + 1
If p = TextBox196.Value Then Outcome.Rows(j).Value = Source.Rows _
(p.Row).Value
Next p
For Each q In Source.Range("A1:A" & Source.Cells(Rows.Count, "A").End(xlUp).Row)
j = Outcome.Cells(Rows.Count, 3).End(xlUp).Row + 1
If q = TextBox197.Value Then Outcome.Rows(j).Value = Source.Rows _
(q.Row).Value
Next q
For Each r In Source.Range("A1:A" & Source.Cells(Rows.Count, "A").End(xlUp).Row)
j = Outcome.Cells(Rows.Count, 3).End(xlUp).Row + 1
If r = TextBox198.Value Then Outcome.Rows(j).Value = Source.Rows _
(r.Row).Value
Next r
For Each s In Source.Range("A1:A" & Source.Cells(Rows.Count, "A").End(xlUp).Row)
j = Outcome.Cells(Rows.Count, 3).End(xlUp).Row + 1
If s = TextBox199.Value Then Outcome.Rows(j).Value = Source.Rows _
(s.Row).Value
Next s
Application.ScreenUpdating = True
Workbooks("WorkBook1").Close
MsgBox "done!"
End Sub
I want to do a dynamic sum formula in VBA and it's some how very difficult for me because I don't use well integer variables.
the last row might change in the future and I need that the range will be dynamic.
thanks to those who will help me.
Sub SumColumns()
Sheets("data").Select
Range("A1").End(xlDown).Offset(1, 0).Select
Selection.Value = "sum"
Selection.Interior.ColorIndex = 33
Selection.Font.Bold = True
Dim LastCol As Integer
Dim LastRow As Integer
With Sheets("data")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
Range("A1").End(xlDown).Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=SUM(R[- " & LastRow & " + 1]C:R[-1]C)"
Selection.AutoFill Destination:=Range("B" & LastRow, "I" & LastRow), Type:=xlFillDefault
End Sub
that is the line with the error:
ActiveCell.FormulaR1C1 = "=SUM(R[- " & LastRow & " + 1]C:R[-1]C)"
Take the + 1 out of the quotes as that seems to be causing the problem and you need to deduct 1 otherwise you will be on row zero. The code below also removes your selects which are unnecessary and inefficient. And use your LastCol variable to determine across how many columns to copy the formula.
Sub SumColumns()
Dim LastCol As Long 'use Long rather than Integer
Dim LastRow As Long
With Sheets("data")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
With .Range("A" & LastRow + 1)
.Value = "sum"
.Interior.ColorIndex = 33
.Font.Bold = True
End With
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range("B" & LastRow + 1).Resize(, LastCol - 1).FormulaR1C1 = "=SUM(R[-" & LastRow - 1 & "]C:R[-1]C)"
End With
End Sub
You can get rid of many select portions and steam line code like below. Test it and see if this is what you are after.
Sub SumColumns()
Dim LastCol As Long
Dim LastRow As Long
With Sheets("data")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
With .Range("A" & LastRow).Offset(1, 0)
.Value = "SUM"
.Interior.ColorIndex = 33
.Font.Bold = True
End With
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A" & LastRow).Offset(0, 1).FormulaR1C1 = "=SUM(R[-" & LastRow - 1 & "]C:R[-1]C)"
.Range("A" & LastRow).Offset(0, 1).AutoFill Destination:=.Range("B" & LastRow, .Cells(LastRow, LastCol)), Type:=xlFillDefault
.Range("A" & LastRow, .Cells(LastRow, LastCol)).Borders.LineStyle = xlContinuous
.Range("A" & LastRow, .Cells(LastRow, LastCol)).Borders.Weight = xlThin
End With
End Sub
I've tried to combine different VBA codes into only one to avoid multiple macros. It works (I get the desired output) but I'd like to know if the code will always work (e.g. if the sheets are not well defined) and if I can simply it (reduce the number of code rows). Here is it :
Sub test2()
Dim sht As Worksheet, cell As Range, areaToTrim As Range, LastRow As Long, lstrow As Long, lrow As Long, sht1 As Worksheet, sht2 As Worksheet
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
Set sht = ThisWorkbook.Worksheets("JDE_Greece")
sht.Activate
Range("A1").EntireColumn.Insert
Sheets("JDE_Greece").Cells(1, 1) = "KEY"
Range("I1").EntireColumn.Insert
sht.Cells(1, 9) = "Quantity JDE (aggregated)"
Range("J1").EntireColumn.Insert
sht.Cells(1, 10) = "Item Code CDL (decomposed)"
Range("K1").EntireColumn.Insert
sht.Cells(1, 11) = "Item Code CDL"
Range("L1").EntireColumn.Insert
sht.Cells(1, 12) = "Quantity CDL (decomposed)"
Range("M1").EntireColumn.Insert
sht.Cells(1, 13) = "Quantity CDL"
Range("N1").EntireColumn.Insert
sht.Cells(1, 14) = "Overwrite (abs in vol)"
Range("O1").EntireColumn.Insert
sht.Cells(1, 15) = "Overwrite (abs in %)"
Range("P1").EntireColumn.Insert
sht.Cells(1, 16) = "Hit/Miss"
Set areaToTrim = Sheets("JDE_Greece").Range("G2:G" & LastRow)
For Each cell In areaToTrim
cell.Value = Trim(cell.Value)
Next cell
Columns("G:G").Select
Selection.NumberFormat = "#"
Range("J2:J" & LastRow).Value = "=IF(ISNA(VLOOKUP(G2,'mapping codes'!A:B,2,0)),G2,VLOOKUP(G2,'mapping codes'!A:B,2,0))"
Range("J2:J" & LastRow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.NumberFormat = "#"
Range("K2:K" & LastRow).Formula = "=IF(ISNA(VLOOKUP(""*""&J2&""*"",CDL_Greece!D:D,1,0)),J2,VLOOKUP(""*""&J2&""*"",CDL_Greece!D:D,1,0))"
Range("K2:K" & LastRow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.NumberFormat = "#"
Range("A2").Formula = "=K2&B2"
Range("A2").Copy Range("A3:A" & LastRow)
lstrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("I2:I" & lstrow).Value = "=SUMIFS(H:H,G:G,G2,A:A,A2)"
Range("I2:I" & lstrow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveSheet.Range("A2:M" & LastRow).RemoveDuplicates Columns:=1, Header:=xlNo
lrow = Cells(Rows.Count, "A").End(xlUp).Row
Range("L2:L" & lrow).Value = "=VLOOKUP(A2,CDL_Greece!A:I,9,0)"
Range("L2:L" & lrow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("M2:M" & lrow).Value = "=IF(ISNA(L2),VLOOKUP(VLOOKUP(""*""&G2&""*"",CDL_Greece!D:D,1,0)&B2,CDL_Greece!A:I,9,0),L2)"
Range("M2:M" & lrow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("N2:N" & lrow).Value = "=ABS(M2-I2)"
Range("O2:O" & lrow).Value = "=ABS(I2-M2)/M2"
Range("O2:O" & lrow).Select
Selection.NumberFormat = "0.00%"
Range("P2:P" & lrow).Value = "=IF(M2=I2,1,0)"
Rows("1:1").Select
Selection.AutoFilter
Range("A1").Interior.Color = RGB(0, 255, 51)
Range("B1:H1").Interior.Color = RGB(255, 153, 102)
Range("I1:M1").Interior.ColorIndex = 37
Range("N1:P1").Interior.ColorIndex = 6
Set sht = ThisWorkbook.Worksheets("JDE_Greece")
Set sht1 = ThisWorkbook.Worksheets("Mismatches")
With sht
lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("M1").AutoFilter Field:=13, Criteria1:="#N/A"
.Range("A1:P" & lrow).SpecialCells(xlCellTypeVisible).Copy
End With
sht1.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Set sht2 = ThisWorkbook.Worksheets.Add
With sht2
.Name = "Summary DRP"
.Move After:=ThisWorkbook.Worksheets("Instructions")
End With
With sht
.Range("M1").AutoFilter Field:=13, Criteria1:="<>#N/A"
.Range("A1:P" & lrow).SpecialCells(xlCellTypeVisible).Copy
End With
sht2.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End Sub
Sorry in advance if it's a bit long (I've even removed my personal comments..).
Thanks a lot for your expertise :)
VBA novice and got 90% of the way to what I need but I just can't figure out the final part. For the last step I have a range of data from A:K, with A containing a unique number. An updated version of this data is pasted below the initial range with the numbers in Column A staying the same, but B:K being updated.
How can i copy the duplicate row below, paste it over the original above, and then delete the duplicate?
Sub TEST2()
'
' TEST2 Macro
'
' Sheets("Sheet1").Select
ActiveSheet.Range("A1:K1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$L$20").AutoFilter Field:=8, Criteria1:="red"
Range("a2").Select
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:K" & LR).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select
Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ActiveSheet.Range("A1:l100").RemoveDuplicates Columns:=Array(1, 1), Header:=xlYes
End With
Range("$q$1").Select
Selection.Copy
Range("H2:H1000").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Sheet1").Select
Worksheets("Sheet1").ShowAllData
Range("O3").Select
Sheets("Sheet2").Select
Range("O3").Select
End Sub
At the moment i can only get as far as using this to delete the duplicates. There are other elements to the sheet which require it to be done this way.
Thanks in advance for any help!!
First thought after seeing the issue... it's a little more than a single line:
Dim i as integer, LR as Long
LR = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 to LR 'Assumes that row 1 is headers
If Application.Match(Cells(i,1),Range(Cells(2,1),Cells(i-1,1)),0)>0 Then
Rows(i).Cut
Rows(Application.Match(Cells(i,1),Range(Cells(2,1),Cells(i-1,1)),0)+1).PasteSpecial xlPasteValues
Else
End If
Next i
Edit: It's not liking the range; I will try cleaning it up, then use insert/delete... keep in mind, if we're using delete for any row, you'll want to reverse the step, as to avoid issues. See below changes, noting that j is added:
Dim i As Integer, j As Integer, LR As Long
LR = Cells(Rows.Count, "A").End(xlUp).Row
For i = LR To 3 Step -1 'Assumes that row 1 is headers
If Application.IfError(Application.Match(Cells(i, 1), Range(Cells(2, 1), Cells(i - 1, 1)), 0), 0) > 0 Then
j = Application.Match(Cells(i, 1), Range(Cells(2, 1), Cells(i - 1, 1)), 0)
Range(Cells(i, 1), Cells(i, 11)).Cut
Range(Cells(j + 1, 1), Cells(j + 1, 11)).Insert xlShiftDown
Range(Cells(j + 2, 1), Cells(j + 2, 11)).Delete
End If
Next i
You can use the below algorithm (with illustrated example as below) :-
Create a column to store sequential number for sorting purpose
Perform the sorting so that the latest appended rows are always at the top. Excel's removeduplication function will always keep the first encountered unique value
Once done, you can perform sorting to re-order the rows of data again.
Below is a sample code which you will need to modify based on your actual dataset.
Sub Test()
LastRow = Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
Range("L1").Value = LastRow
Range("L2").Value = LastRow - 1
Range("L1:L2").AutoFill Destination:=Range("L1:L" & LastRow)
Range("A1:L" & LastRow).Sort Order1:=xlAscending, Key1:=Range("L1"), Header:=xlNo
Range("A1:L" & LastRow).RemoveDuplicates Columns:=Array(1, 1), Header:=xlNo
End Sub
I'm trying to add new columns to the end of the data and autofill a function. Here's my code. I got an error in the autofill part. range of method class failed. Can someone have a look please? Thanks!
Sub Geocode()
'Add Lat and Long columns to the end of the report
Dim lastColumn As Long
Dim lastRow As Long
With Sheets("ReportResults 1")
lastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(1, lastColumn + 1).Value = "Location"
.Cells(1, lastColumn + 2).Value = "Latitude"
.Cells(1, lastColumn + 3).Value = "Longitude"
.Cells(2, lastColumn + 1).FormulaR1C1 = _
"=RC[-17]&"", ""&RC[-16]&"", ""&RC[-15]&"" ""&RC[-14]&"", USA"""
'auto fill formula
.Range(lastColumn + 1 & "2").Select
Selection.AutoFill Destination:=Range(lastColumn + 1 & "2:" & lastColumn + 1 & lastRow)
'copay paste value
Columns(lastColumn + 1).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
End Sub
These lines are going to cause a problem because they are not in a proper named range format:
.Range(lastColumn + 1 & "2").Select
Selection.AutoFill Destination:=Range(lastColumn + 1 & "2:" & lastColumn + 1 & lastRow)
Instead try this:
.Cells(2, lastColumn + 1).Select
Selection.AutoFill Destination:=Range(Cells(2, lastColumn + 1), Cells(lastRow, lastColumn + 1))
Or even better on a single line:
.Cells(2, lastColumn + 1).AutoFill Destination:=Range(Cells(2, lastColumn + 1), Cells(lastRow, lastColumn + 1))