Turn on Option Explicit from the menu via Tools>Options>Editor tab>Require Variable Declaration. This mandates you `Dim lastRow as long` before using it anywhere. Doing this will save you needless frustration later down the line when you transpose a variable name `raom` instead of `roam` and time's wasted till you find it. If you have two Ranges that are same size and you want to copy the values over you can do `Foo.Value2 = Bar.Value2` to achieve this without any copying. If you have a Range that is the same size as an array you get the same with `Foo.Value2` = inMemoryArray`. Use descriptive variable names. `x_bf1` doesn't have any meaning, at least to me. If future-you comes back to this code and doesn't know what it means you'll be wishing past-you had used a descriptive name. An example of this being useful is the comments `'Date` in two locations. Renaming `copyrange1` to `dateArea` will cause these comments to become redundant and removable as your code is self documenting already describing *what* it is doing, save comments for *why*. ```vb Set copyrange1 = x_bf1.Range("D8:D" & lastrow_s) 'Date ... copyrange1.SpecialCells(xlCellTypeVisible).Copy 'Date pasterange1.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone ``` becomes ```vb destinationArea.Offset(0, 1).Value2 = dateArea.Value2 ``` Tied to naming is the use of `_` underscore. If you end up using interfaces be aware that this is how interface implementation is done. Double click on your first worksheet then at the dropdowns at the top select `Worksheet` from the left dropdown, and `SelectionChange` from the right dropdown. You get `Private Sub Worksheet_SelectionChange(ByVal Target As Range)` which is an example of the underscore used this way. You turn off `ScreetUpdating` and the rest, but it's never turned back on in your provided code. Make sure that is restored. ```vb With Application .ScreenUpdating = False .Calculation = xlCalculationManual .DisplayAlerts = False .EnableEvents = False End With ``` You're using a named range from a workbook. Every usage of them includes `RefersToRange(1, 1)`. If your names are single cell Ranges this is redundant. <hr> Refactored Code. ```vb Public Sub Refactor() Dim x_bf1 As Worksheet Dim lo_b1 As ListObject Set lo_b1 = x_bf1.ListObjects(1) Dim s_date As Long s_date = CLng(ThisWorkbook.Names("in_fre_m").RefersToRange(1, 1)) Dim s_des As Range s_des = ThisWorkbook.Names("dr_no").RefersToRange(1, 1) Dim s_code As Range s_code = ThisWorkbook.Names("dr_co").RefersToRange(1, 1) Dim lastrow_d As Long Dim lo_dr As ListObject lastrow_d = lo_dr.Range.Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 With lo_b1.Range .AutoFilter Field:=13, Criteria1:=s_code .AutoFilter Field:=1, Criteria1:="<=" & s_date End With Dim lastrow_s As Long lastrow_s = lo_b1.Range.Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row If lastrow_s > 7 Then Dim dateArea As Range Set dateArea = x_bf1.Range("D8:D" & lastrow_s) Dim description As Range Set description = dateArea.Offset(0, 1) Dim calculationArea As Range Set calculationArea = dateArea.Offset(0, 16) Dim classification As Range Set classification = dateArea.Offset(0, 5) Dim notes As Range Set notes = dateArea.Offset(0, 6) Dim parragraph As Range Set parragraph = dateArea.Offset(0, 11) Dim code As Range Set code = dateArea.Offset(0, 12) Dim statutory As Range Set statutory = dateArea.Offset(0, 20) Dim reference As Range Set reference = dateArea.Offset(0, 14) Dim x_drill As Worksheet Dim destinationArea As Range Set destinationArea = x_drill.Range("C" & lastrow_d).Resize(dateArea.Rows.Count, 9) Dim singlePopulationHelper() As String singlePopulationHelper = LoadHelperArraywWithValues(reference, _ dateArea, _ classification, _ description, _ code, _ parragraph, _ calculationArea, _ statutory, _ notes) destinationArea.Value2 = singlePopulationHelper End If End Sub Private Function LoadHelperArraywWithValues(ParamArray values()) As String() Dim rowCount As Long rowCount = values(0).SpecialCells(xlCellTypeVisible).Cells.Count Dim columnCount As Long columnCount = UBound(values) Dim helperArray() As String ReDim helperArray(rowCount, columnCount) Dim populationColumn As Long For populationColumn = 0 To columnCount Dim workingColumn As Range Set workingColumn = values(populationColumn) Dim populationRow As Long populationRow = 0 Dim subArea As Range For Each subArea In workingColumn.SpecialCells(xlCellTypeVisible).Areas Dim cell As Range For Each cell In subArea helperArray(populationRow, populationColumn) = cell.Value2 populationRow = populationRow + 1 Next Next Next LoadHelperArraywWithValues = helperArray End Function ``` Alternate copying to temporary worksheet. ```vb Private Function CopyToTempSheetBeforeLoading(ParamArray values()) As Variant Dim populatedColumns As Long Dim tempSheet As Worksheet Set tempSheet = ThisWorkbook.Worksheets.Add For populatedColumns = 0 To UBound(values) values(populatedColumns).SpecialCells(xlCellTypeVisible).Copy tempSheet.Range("B2").Offset(ColumnOffset:=populatedColumns).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone Next CopyToTempSheetBeforeLoading = tempSheet.Range("B2").CurrentRegion tempSheet.Delete End Function ```