Home > OS >  vba excel special range paste
vba excel special range paste

Time:11-08

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.

CodePudding user response:

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
  • Related