Excel Macro Copy Range Paste offset based on cell value

Question

I have two sheets "Data" - which has raw data and "Report" - as Report form .

Report sheet first 5 rows has info.
Data Sheet there 6 columns of Data available (SlNo Name Desig Place gender Category)
Report sheet has first 5 columns only (SlNo Name Desig Place gender)
Report sheet range C5 is dropdown box (List from Category column of Data sheet).

So based on this C5 value get details from Data sheet and paste in Report sheet.

I tried the following code but it pastes the whole row when I want to paste only Name,Desig,Place,gender details in offset and loop...

Sub ViewBtn()
Dim SCHL As String
Dim x As Long
x = 2
Do While Cells(x, 1) <> ""
Sheets("Report").Range(Cells(x, 1).Address, Cells(x, 5).Address).ClearContents
x = x + 1
Loop
Dim id As String
id = ActiveSheet.Range("C5").Value
x = 2
Sheets("Data").Select
Category = id
Do While Cells(x, 1) <> ""
If Cells(x, 4) = Category Then
Worksheets("Data").Rows(x).Copy
Worksheets("Report").Activate
erow = Sheets("Report").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Report").Rows(erow)
  End If
Worksheets("Data").Activate
 x = x + 1
   Loop
  Application.CutCopyMode = False
 Worksheets("Report").Activate

 End Sub

This almost works. You are copying the entire row: Worksheets("Data").Rows(x).Copy Search around and see how to copy certain columns within the row. — dev1998
IMHO your code is not very clear - some comments and consistent indentation would help. I can't see how it generates the result that you say. For example, the loop that clears the Report sheet from row 2 (the report starts in row 6?) looks as if it might clear cell C5, which contains the category, before referring to it. Then, it checks Category against Data column 4, but your question implies Category is in Data column 6. Re the point of your question: the whole row is pasted, IMHO, simply because you are copying the whole row. You should just copy the cell range you need. — JohnRC
exactly both of you... I am struggle in that step how do copy that range... — KID IN EXCEL
If you only want to copy (for instance) columns B:E, just change your Copy statement to just copy columns B:E - e.g. Worksheets("Data").Rows(x).EntireRow.Range("B1:E1").Copy or Worksheets("Data").Range("B" & x & ":E" & x).Copy. There are many, many more examples on the internet of copying certain cells rather than whole rows that I am surprised that you managed to find a Rows(x).Copy before you found what you were looking for. — YowE3K

JohnRC JohnRC · Accepted Answer · 2018-01-21T18:33:14

Here is some sample code to do what I think you are asking for. It is not necessarily the shortest or cleverest way to do it, but everything is done step by step so I hope it is clear enough to follow easily.

Option Explicit

Private Sub viewBtn_Click()

    '// Set references to worksheets
    Dim wsReport As Worksheet: Set wsReport = Sheets("Report")
    Dim wsData As Worksheet: Set wsData = Sheets("Data")

    '// Get the category to be reported
    Dim sCategory As String
    sCategory = wsReport.Range("C5")

    '// Reference first line of the report, in row 8
    Dim rFirstReportLine As Range
    Set rFirstReportLine = wsReport.Range("A8:E8")

    '// Reference the line of the report to be written
    Dim rReportLine As Range
    Set rReportLine = rFirstReportLine

    '// Clear the old report area
    Do While rReportLine.Cells(1, 1) <> ""
        rReportLine.Clear
        Set rReportLine = rReportLine.Offset(1, 0)
    Loop

    '// Reset to first line of the report
    Set rReportLine = rFirstReportLine

    '// Find the first cell, if any, that matches the category
    Dim rMatch As Range
    Set rMatch = wsData.Range("F:F").Find(sCategory, , , xlWhole)


    '// Get reference to top data row of data sheet, just the cols to be copied
    Dim rDataRow As Range: Set rDataRow = wsData.Range("A1:E1")

    '// check for at least one match
    If Not rMatch Is Nothing Then

        '// Save the address of the first match for checking end of loop with FindNext
        Dim sFirstMatchAddress As String:   sFirstMatchAddress = rMatch.Address

        Do
            '// 1) .. copy data row to the report line
            rDataRow.Offset(rMatch.Row - 1).Copy rReportLine

            '// 2) .. move the report line down
            Set rReportLine = rReportLine.Offset(1, 0)

            '// 3) .. find the next match on category
            Set rMatch = wsData.Range("F:F").FindNext(rMatch)

            '// 4) .. exit when we have looped around
        Loop Until rMatch.Address = sFirstMatchAddress
    End If

    '// Display the number of entries found at the end of the report
    With rReportLine
        Dim nEntryCount As Integer: nEntryCount = .Row - rFirstReportLine.Row
        .Cells(1, 1) = nEntryCount & IIf(nEntryCount = 1, " Entry", " Entries")
        .Font.Italic = True
        .Font.Color = vbBlue
    End With

    '// Make sure the report sheet is displayed
    wsReport.Activate

End Sub

With this data

Get this result

Excel Macro Copy Range Paste offset based on cell value

1 Answers