My Intention:

I wanna select all values in Rows "B" and "C" and move these 1 and 2 steps up.

• The Example for what I have:

• The Example for what I would: If in Column-A find "X" should YY and CC delet

• My Code:

Sub test()

ActiveSheet.Select
Range("B:B").Select Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C:C").Select Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove

End Sub 

I would be happy if somebody help me

CodePudding user response：

select all cells (A1:C5) and start the following macro

Sub FillCells()
Dim rngCell As Range


Do Until Application.WorksheetFunction.CountBlank(Selection) = 0

  For Each rngCell In Selection
  
  If rngCell.Value = "" Then
   
   rngCell.Value = rngCell.Offset(1, 0).Value
   
  End If
  
  Next rngCell

Loop

End Sub

Best regards Bernd

CodePudding user response：

Align Data

Option Explicit

Sub AlignData()
    
    Const Cols As String = "A:C"
    Const fRow As Long = 1
    Const ExceptionsList As String = "XX" ' comma-separated, no spaces!
    Const Gap As Long = 1 ' number of empty rows in-between
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    ' Reference the source range.
    Dim srg As Range
    Dim srCount As Long
    With ws.Rows(fRow).Columns(Cols).Resize(ws.Rows.Count - fRow   1)
        Dim lrCell As Range
        Set lrCell = .Find("*", , xlFormulas, , xlByRows, xlPrevious)
        If lrCell Is Nothing Then Exit Sub ' no data
        srCount = lrCell.Row - fRow   1
        Set srg = .Resize(srCount)
    End With
    
    Dim cCount As Long: cCount = srg.Columns.Count
    ' 1 to hold each column array
    ' 2 to hold a collection of each column's matching values
    Dim jArr As Variant: ReDim jArr(1 To cCount, 1 To 2)
    
    Dim Exceptions() As String: Exceptions = Split(ExceptionsList, ",")
    
    Dim crg As Range
    Dim c As Long
    Dim r As Long
    Dim sValue As Variant
    
    ' Write the column arrays to the jagged array.
    For c = 1 To cCount
        jArr(c, 1) = srg.Columns(c).Value ' column arrays
        Set jArr(c, 2) = New Collection ' to hold the matching values
    Next c
    
    ' Use a dictionary to hold the indexes of (unwanted) exception matches.
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    
    Dim dStep As Long: dStep = Gap   1
    
    Dim dData As Variant
    Dim drCount As Long
    Dim dr As Long
    Dim sr As Long
    
    For c = 1 To cCount
        dr = 0
        For sr = 1 To srCount
            sValue = jArr(c, 1)(sr, 1)
            If Not IsEmpty(sValue) Then ' exclude empty values
                dr = dr   1
                If c = 1 Then ' 1st array
                    If IsError(Application.Match(sValue, Exceptions, 0)) Then
                        jArr(c, 2).Add sValue
                    Else ' found in exceptions
                        dict(dr) = Empty ' add the index
                    End If
                Else ' all but the 1st array
                    If Not dict.Exists(dr) Then
                        jArr(c, 2).Add sValue
                    End If
                End If
            End If
        Next sr
        ' Write the values from the collection to the destination array.
        If c = 1 Then
            drCount = jArr(c, 2).Count * dStep - 1
            ReDim dData(1 To drCount, 1 To cCount)
        End If
        For sr = 1 To drCount Step dStep
            dData(sr, c) = jArr(c, 2)(Int(sr / dStep)   1)
        Next sr
        Set jArr(c, 2) = Nothing
    Next c
            
    ' Write the values from the destination array to the range and clear below.
    With srg.Resize(drCount)
        .Value = dData
        .Resize(ws.Rows.Count - .Row - drCount   1).Offset(drCount).Clear
    End With
            
End Sub