Search code examples
excelvbapaste

vba excel special range paste


My question is there vba excel command that will allow paste to specific cells ,if those specific cells are full find next specific cell that are avabile for paste of data ?

For exemple

Range of cells A1:E5 are specific cell range where i can paste data. But range of cell from A6:E11 is field of cells where i can't paste data and need to be jumped over to next available range of cells

Thanks in advance for answers or direction of subject that have same question.

I hope u understood what i wanted to say.

I have no code.Tried to find cod on internet or something similar but seems could not find similar situation.


Solution

  • Fill Blanks

    enter image description here

    Sub FillBlanks()
        
        Dim wb As Workbook: Set wb = ThisWorkbook
        Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
        Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion
        
        Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
        Dim drg As Range: Set drg = dws.Columns("A:C")
        Dim dcCount As Long: dcCount = drg.Columns.Count
        
        Dim dr As Long: dr = 1
        Dim dc As Long: dc = 1
    
        Dim sCell As Range
        Dim dCell As Range
        
        For Each sCell In srg.Cells
            If Len(CStr(sCell.Value)) > 0 Then ' the source cell is not blank
                Do
                    Set dCell = drg.Cells(dr, dc) ' current destination cell
                    
                    ' Determine the next destination row and column.
                    If dc < dcCount Then dc = dc + 1 Else dc = 1: dr = dr + 1
                    
                    If Len(CStr(dCell.Value)) = 0 Then ' destination cell is blank
                        sCell.Copy dCell ' copy; more illustrative
                        'dCell.Value = sCell.Value ' write values; more efficient
                        Exit Do
                    'Else ' the destination cell is not blank; do nothing
                    End If
                Loop
            'Else ' the source cell is blank; do nothing
            End If
        Next sCell
    
    End Sub