Copying cell values from one sheet to another, and paste it near a cell with specific value

Question

I have a constant task at work where I need to copy a list of numbers to another sheet. In that sheet, I need to paste those numbers one by one, in a cell to the right of cells with a certain value(that repeats in a column). (notice that the target table is sorted by that value -"מודל תגובה" and there are hidden rows.

It's hard to explain so I hope the images will do.

I tried to write suitable code but I kept getting different errors. It seems that problems occur when copying the cell values to the target cells.

Dim i As Integer
i = 4

Do While IsEmpty(Cells(i, 1).Value) = False
    Worksheets(1).Select
    Cells(i, 1).Copy
    Worksheets(2).Select
    Cells.Find(What:="מודל תגובה", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(0, -1).Activate

    If IsEmpty(ActiveCell.Value) = False Then
         Selection.FindNext(After:=ActiveCell).Activate
         ActiveCell.Offset(0, -1).Paste
    Else
         ActiveCell.Offset(0, -1).Select
         ActiveCell.Paste  
    End If

    i = i + 1
Loop

sorry for the shitty code(literally my first macro).

*"I kept getting different errors"* Which error do you get and in which line of code? It's hard to help without knowing what is going wrong • You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — Pᴇʜ, Feb 25 '21 at 13:55

Pᴇʜ · Accepted Answer · 2021-02-25T14:55:31.560

The solution would be to loop through the visible cells of the filtered range only.

Make sure the destination is filtered for "מודל תגובה" before running this code. It needs to look like your second image before running this code.

Dim SourceSheet As Worksheet
Set SourceSheet = Worksheets(1)

Dim DestinationSheet As Worksheet
Set DestinationSheet = Worksheets(2)

Dim LastRow As Long
LastRow = DestinationSheet.Cells(DestinationSheet.Rows.Count, "B").End(xlUp).Row

Dim VisibleCells As Range
On Error Resume Next 'next line errors if no visible cells so we turn error reporting off
Set VisibleCells = DestinationSheet.Range("A2", "A" & LastRow).SpecialCells(xlCellTypeVisible)
On Error Goto 0 'turn error reporting on or you won't see if other errors occur

If VisibleCells Is Nothing Then  'abort if no cells are visible in the filter
    MsgBox "No cells to paste at"
    Exit Sub
End If

Dim SourceRow As Long
SourceRow = 4   'start row in your source sheet

Dim Cell As Range
For Each Cell In VisibleCells.Cells    'loop through visible cells
    Cell.Value = SourceSheet.Cells(SourceRow, "A").Value 'copy value
    SourceRow = SourceRow + 1  'incerease source row
Next Cell

Make sure to define DestinationSheet and SourceSheet with your sheets names.

@yachninho for what? where? A bit more information than half a sentence could be helpful. • If you mean for source and destination, yes you can. But if anyone moves your sheet(1) into position (2) your code fails. `Worksheet(1)` means take whatever worksheet is the first tab in the row. Anyone can easily change that and your data gets messed up. — Pᴇʜ, Feb 25 '21 at 14:50
sorry. yes i meant instead of source and destination. the thing is the sheet name will be changing with each file. many thanks for your help anyway — yachninho, Feb 25 '21 at 14:53

Copying cell values from one sheet to another, and paste it near a cell with specific value

1 Answers1