VBA to move range if cell value is not empty

[fotodj]

Sub MoveRange()

 Dim i As Long
    For i = 2 To 10
 
        If Not IsEmpty(Range("A" & i)) Then _
            Range("F" & i) = Range("A" & i)
        If Not IsEmpty(Range("A" & i)) Then _
            Range("G" & i) = Range("B" & i)
        If Not IsEmpty(Range("A" & i)) Then _
            Range("H" & i) = Range("C" & i)
       
        If Not IsEmpty(Range("A" & i)) Then _
            Range("C" & i).ClearContents
        If Not IsEmpty(Range("A" & i)) Then _
            Range("B" & i).ClearContents
        If Not IsEmpty(Range("A" & i)) Then _
            Range("A" & i).ClearContents
  
                   
    Next i
 
End Sub

So far my "poor" coding attempt moves the Range ("A:C") to Range("F:H") and clear contents of Range ("A:C") where A cell was not empty... I need help to modify it...
the goal is to move Range(A:C) to next empty row in Range ("F:H") if Col A not empty. After the move, the range("A:C") where A cell was not empty should be deleted.

 

[HighAndWilder]

View attachment 119184

Sub MoveRange()

 Dim i As Long
    For i = 2 To 10
 
        If Not IsEmpty(Range("A" & i)) Then _
            Range("F" & i) = Range("A" & i)
        If Not IsEmpty(Range("A" & i)) Then _
            Range("G" & i) = Range("B" & i)
        If Not IsEmpty(Range("A" & i)) Then _
            Range("H" & i) = Range("C" & i)
      
        If Not IsEmpty(Range("A" & i)) Then _
            Range("C" & i).ClearContents
        If Not IsEmpty(Range("A" & i)) Then _
            Range("B" & i).ClearContents
        If Not IsEmpty(Range("A" & i)) Then _
            Range("A" & i).ClearContents
 
                  
    Next i
 
End Sub

So far my "poor" coding attempt moves the Range ("A:C") to Range("F:H") and clear contents of Range ("A:C") where A cell was not empty... I need help to modify it...
the goal is to move Range(A:C) to next empty row in Range ("F:H") if Col A not empty. After the move, the range("A:C") where A cell was not empty should be deleted.

What version of Excel are you using as it may be possible by just using a formula?

 

[fotodj]

@HighAndWilder 2016 Pro Plus

 

[Joe4]

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

 

[HighAndWilder]

View attachment 119184

Sub MoveRange()

 Dim i As Long
    For i = 2 To 10
 
        If Not IsEmpty(Range("A" & i)) Then _
            Range("F" & i) = Range("A" & i)
        If Not IsEmpty(Range("A" & i)) Then _
            Range("G" & i) = Range("B" & i)
        If Not IsEmpty(Range("A" & i)) Then _
            Range("H" & i) = Range("C" & i)
      
        If Not IsEmpty(Range("A" & i)) Then _
            Range("C" & i).ClearContents
        If Not IsEmpty(Range("A" & i)) Then _
            Range("B" & i).ClearContents
        If Not IsEmpty(Range("A" & i)) Then _
            Range("A" & i).ClearContents
 
                  
    Next i
 
End Sub

So far my "poor" coding attempt moves the Range ("A:C") to Range("F:H") and clear contents of Range ("A:C") where A cell was not empty... I need help to modify it...
the goal is to move Range(A:C) to next empty row in Range ("F:H") if Col A not empty. After the move, the range("A:C") where A cell was not empty should be deleted.

Try this.

Make sure that the sheet is the active sheet.

Public Sub subRearrange()
Dim rngLeft As Range
Dim rngRight As Range
Dim arr() As Variant
Dim i As Integer

  Set rngLeft = Range("A2:C7") ' <= Change this to the block of data indicated
                                  ' in orange on the example sheet.
  
  Set rngRight = Range("F3:H3") ' <= Change this to the last row of data
                                  ' as indicated in purple on the example sheet.

  arr = rngLeft.Value
  
  rngLeft.ClearContents
  
  Set rngLeft = rngLeft.Cells(1).Resize(1, 3).Offset(-1, 0)
  
  For i = 1 To UBound(arr)
    
    If arr(i, 1) <> "" Then
    
      Set rngRight = rngRight.Offset(1, 0)
      
      rngRight.Value = Array(arr(i, 1), arr(i, 2), arr(i, 3))
      
    Else
      
      Set rngLeft = rngLeft.Offset(1, 0)
      
      rngLeft.Value = Array(arr(i, 1), arr(i, 2), arr(i, 3))
    
    End If
  
  Next i
  
End Sub

VBA to move range if cell value is not empty.xlsm
	A	B	C	D	E	F	G	H
1	Col A	Col B	Col C			Col F	Col G	Col H
2	456	FGH	EEE			111	TTT	OOO
3	789	GHN	FFF			222	UUU	WWW
4		WER
5	724	DFG	HHH
6		MKY
7	455	HYO	DDD
Sheet1

 

[fotodj]

@HighAndWilder Thank you for your help, great VBA lesson!