VBA - Copy data from one sheet to another based on data in a column

[stormseeker75]

Here's my setup:

Workbook = WORK_ORDERS
Worksheet = DATABASE
Worksheet = SALES_SHEET_MASTER

DATABASE has the following columns
ITEM_NO
ACCEPT
DECLINE
HOURS
COMPLAINT_1
COMPLAINT_2
CAUSE
CORRECTION

SALES_SHEET_MASTER has a much less organized layout because the spreadsheet is being used as a repair order form. What matters is that I have a a repeating series of blocks of data. For each block, I have an ascending number (1, 2, 3....) in column R.

What I would like the code to do is to look through column R on SALES_SHEET_MASTER and anytime it finds a number, I want it to copy certain cells to the DATABASE tab into each column.

I have done a bit of reading and I don't know if we should use a For...Next or a Range.Find. I think that when the code finds a number, we could use Offset to create a relative position to copy? I have no idea how to do the loop through the paste portion but I wanted to at least give a try on the loop to find the data and select it.

The first cell I am trying to select and copy is in Column A. I don't know how to paste once I've selected it. There are also other cells that need to be copied to the DATABASE tab. If my offset methodology is correct, I can probably figure that part out.

For Each cell In SALES_SHEET_MASTER.Range("R1:R & Cells(Rows.Count, 2).End(xlUp).Row)
    If Not IsEmpty(cell) Then
        activecell.offset.(columnOffset:=-17).select
        selection.copy
    End If
Next

 

[sofas]

I think that when the code finds a number

Here you are looking for the presence of a number and the code shown below checks for spaces. Here is this suggestion, you can modify it to suit you

Sub CopyDataToDatabaseSheet()
    Dim WS As Worksheet, dest As Worksheet
    Dim lastRow As Long, tbl As Long, ColArr As Variant, OnRng As Variant, i As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Set WS = Sheets("SALES_SHEET_MASTER")
    Set dest = Sheets("DATABASE")

    lastRow = WS.Cells(WS.Rows.Count, "R").End(xlUp).Row
    tbl = dest.Cells(dest.Rows.Count, 1).End(xlUp).Row + 1

    ' Select the columns we want to copy
    ColArr = Array(1, 2, 3, 4, 5, 6, 7, 8) ' columns A¡ B¡ C¡ D¡ E¡ F¡ G¡ H

    OnRng = WS.Range(WS.Cells(1, ColArr(0)), WS.Cells(lastRow, ColArr(UBound(ColArr)))).Value
  
    For i = 1 To UBound(OnRng, 1)
    'If the cell in column R contains a value (not blank)
     If Not IsEmpty(WS.Cells(i, 18).Value) Then
    
     'If the cell in column R contains a (numeric) value
       ' If IsNumeric(WS.Cells(i, 18).Value) Then
      
            dest.Cells(tbl, 1).Resize(1, UBound(ColArr) + 1).Value = Application.Index(OnRng, i, 0)
            tbl = tbl + 1
        End If
    Next i

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub

 

[stormseeker75]

The values are not in the same row as the number in column R. I've attached a picture to show the layout of the data and the cells I want to copy.