在上次使用的行之后插入新行,并从上面复制公式和格式
我想要一个macros,它会find数据的最后一行,然后插入一个新的行,并从上面复制格式和公式(公式是在列F)。 我每次都在同一个地方插入一行新的代码。 这可能吗?
这是我有:
Sub AddNewRow() ' ' AddNewRow Macro ' ' Rows("37:37").Select ActiveSheet.Unprotect Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("F36").Select Selection.AutoFill Destination:=Range("F36:F37"), Type:=xlFillDefault Range("F36:F37").Select ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=True, AllowDeletingRows:=True, AllowSorting:=True _ , AllowFiltering:=True End Sub
您只需要创buildvariables来查找最后一行和第一个空行,然后使用它们:
Sub AddNewRow() ' AddNewRow Macro Dim LastRw As Long, EmptyRw As Long EmptyRw = WorksheetFunction.CountA(Range("F:F")) + 1 LastRw = WorksheetFunction.CountA(Range("F:F")) Cells(EmptyRw, 6).Select ActiveSheet.Unprotect Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Cells(LastRw, 6).Select Selection.AutoFill Destination:=Range(Cells(LastRw, 6), Cells(EmptyRw, 6)), Type:=xlFillDefault ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=True, AllowDeletingRows:=True, AllowSorting:=True _ , AllowFiltering:=True End Sub
可以使用CurrentRegion
查找最后一行并从那里填充…
Sub AddNewRow() ActiveSheet.Unprotect ActiveSheet.Range("A1").CurrentRegion.Offset(ActiveSheet.Range("A1").CurrentRegion.Rows.Count - 1).Resize(2).FillDown ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=True, AllowDeletingRows:=True, AllowSorting:=True _ , AllowFiltering:=True End Sub
如果工作表内容没有在单元格A1
中或旁边单元格开始,则需要更改Range("A1")