Ivan Kremenjaš
Ivan Kremenjaš

Reputation: 21

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.

Upvotes: 0

Views: 46

Answers (1)

VBasic2008
VBasic2008

Reputation: 54817

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

Upvotes: 1

Related Questions