How to speed up this looping code? - excel

Question

Can you anyone offer assistance on speeding up this code? I am assume an array can be used, but I am terrible using them. Is there another way? Thanks so much!
Application.ScreenUpdating = False
'IF using Indexed Values
If Sheets("interface").Range("C24") = "Y" Then
Dim x As Integer
Dim i As Long
For x = 15 To 51
LastRow = Sheets("db_main").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Sheets("db_main").Range("S" & i) = True And Sheets("db_main").Range("C" & i) = Sheets("interface").Range("F" & x) Then
Sheets("db_main").Range("C" & i).Copy
Sheets("intersource").Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("db_main").Range("A" & i).Copy
Sheets("intersource").Range("B" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("db_main").Range("H" & i).Copy
Sheets("intersource").Range("C" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("db_main").Range("D" & i).Copy
Sheets("intersource").Range("D" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("db_main").Range("M" & i).Copy
Sheets("intersource").Range("E" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("db_main").Range("O" & i).Copy
Sheets("intersource").Range("F" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues
End If
Next i
Next x
End If

Answer 1

If you'd like to avoid using arrays, you could try eliminating the copy/paste in favor of just assigning values (which should improve the performance). Try this out:
'IF using Indexed Values
Application.ScreenUpdating = False
If Sheets("interface").Range("C24") = "Y" Then
Dim x As Long, i As Long, LastRow As Long, _
LastSourceRow As Long, Counter As Long
Dim DBSheet As Worksheet, SourceSheet As Worksheet, _
InterSheet As Worksheet
'identify worksheets for easier reference
Set DBSheet = ThisWorkbook.Worksheets("db_main")
Set SourceSheet = ThisWorkbook.Worksheets("intersource")
Set InterSheet = ThisWorkbook.Worksheets("interface")
For x = 15 To 51
'identify last rows
LastRow = DBSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastSourceRow = SourceSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Counter = 1
For i = 2 To LastRow
If DBSheet.Range("S" & i) = True And DBSheet.Range("C" & i) = InterSheet.Range("F" & x) Then
'write DB column C to Source column A
SourceSheet.Cells(LastSourceRow + Counter, 1) = _
DBSheet.Cells(i, 3).Value
'write DB column A to Source column B
SourceSheet.Cells(LastSourceRow + Counter, 2) = _
DBSheet.Cells(i, 1).Value
'write DB column H to Source column C
SourceSheet.Cells(LastSourceRow + Counter, 3) = _
DBSheet.Cells(i, 8).Value
'write DB column D to source column D
SourceSheet.Cells(LastSourceRow + Counter, 4) = _
DBSheet.Cells(i, 4).Value
'write DB column M to Source column E
SourceSheet.Cells(LastSourceRow + Counter, 5) = _
DBSheet.Cells(i, 13).Value
'write DB column O to Source column F
SourceSheet.Cells(LastSourceRow + Counter, 6) = _
DBSheet.Cells(i, 15).Value
'increment counter
Counter = Counter + 1
End If
Next i
Next x
End If
Application.ScreenUpdating = True