How can I copy range from sheet to sheet based on column value?

Question

I am trying to copy a specified range of cells from one sheet (Sheet2) to a specified range of cells in another sheet (Sheet1) based on a condition. There are hundreds of rows of data, and I would like VBA code that looks at each row, and if the condition is met for that row, copies the specified cell range from sheet2 to sheet1. It is not the entire row being copied, just four cells out of a row with many more cells that contain data.

In more specific terms, I would like to copy columns B through E for each row (starting at row 2) IF the value in column AK for each row is greater than 0. I would like for this data to be pasted into columns B through E in sheet1, starting at row 8. So, for example, if row 2 in Sheet 2 meets the criteria, I would like for B2 through E2 in sheet 2 to be copied to B8 through E8 in sheet 1.

I have tried to adapt code found in other questions on StackOverFlow and other sources but I am very new to VBA and have not been successful. Any help would be greatly appreciated.

Hi & welcome to Stack Overflow! This forum is not for questions about technologies or to find somebody doing the work for free (search some freelance service for that). See How to Ask and Create Minimal Complete and Verifiable Example for ideas about what kind of questions can be made and how to ask. — Angel M.

Asger Asger · Accepted Answer · 2019-01-15T19:07:45

Private Sub CopySomeCells()
    Dim SourceSheet As Worksheet
    Dim DestinationSheet As Worksheet
    Dim SourceRow As Long
    Dim DestinationRow As Long

    Set SourceSheet = ActiveWorkbook.Sheets(2)
    Set DestinationSheet = ActiveWorkbook.Sheets(1)

    DestinationRow = 8
    For SourceRow = 2 To SourceSheet.UsedRange.Rows.Count
        If SourceSheet.Range("AK" & SourceRow).Value > 0 Then
            SourceSheet.Range(SourceSheet.Cells(SourceRow, 2), SourceSheet.Cells(SourceRow, 5)).Copy _
                DestinationSheet.Cells(DestinationRow, 2)
            DestinationRow = DestinationRow + 1
        End If
    Next SourceRow
    Application.CutCopyMode = False

    Set SourceSheet = Nothing
    Set DestinationSheet = Nothing
End Sub

If you just want to paste the values (and not the format) then change two rows by this:

SourceSheet.Range(SourceSheet.Cells(SourceRow, 2), SourceSheet.Cells(SourceRow, 5)).Copy
DestinationSheet.Cells(DestinationRow, 2).PasteSpecial Paste:=xlPasteValues

Or better by this (faster and without clipboard):

DestinationSheet.Cells(DestinationRow, 2).Resize(1, 4).Value = _
    SourceSheet.Cells(SourceRow, 2).Resize(1, 4).Value

How can I copy range from sheet to sheet based on column value?

1 Answers