Excel VBA Copy content from every nth cell and paste into every nth cell

Question

Dear StackOverflow community,

I am making my finances via Excel just to keep track over my financial status. I am using the raw data from my banking site and had a macro to sort the data more less and have it ready for copy pasting. But the macro I created didn't really satisfy me and I am kind of thinking about how to do the following thing in Visual Basic for Application:

I want to:

• select every 3rd cell from a sheet (in my case B3) (done)

  Dim rRange As Range
  Dim rEveryNth As Range
  Dim lRow As Long        
  
  With Tabelle5
      Set rRange = .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
  End With
  
  For lRow = 1 To rRange.Rows.Count Step 3
      If lRow = 1 Then
          Set rEveryNth = rRange(lRow, 1)
      Else
          Set rEveryNth = Union(rRange(lRow, 1), rEveryNth)
      End If
  Next lRow
  
  Application.Goto rEveryNth
  

• put a space after these cells (like literally pressing space bar after every single cell) (done)

  Dim c As Range
  
  For Each c In Selection
      If c.Value <> "" Then c.Value = c.Value & " "
  Next
  

• select every 3rd cell from the same sheet but from another offset (B4) (done)

  With Tabelle5
      Set rRange = .Range("B4", .Cells(.Rows.Count, "B").End(xlUp))
  End With
  
  For lRow = 1 To rRange.Rows.Count Step 3
      If lRow = 1 Then
          Set rEveryNth = rRange(lRow, 1)
      Else
          Set rEveryNth = Union(rRange(lRow, 1), rEveryNth)
  End If
  Next lRow
  
  Application.Goto rEveryNth
  

• copy the text of these cells and then paste them into every 3rd cell starting from B3 WITHOUT erasing the original text from the cells (HELP NEEDED HERE)

• delete every 3rd row starting from B4 (also help needed)

• delete every 2nd row starting from B2 (same as above

• have it copy-ready (just usual copy command, also done)

So as you see I need a trick to somehow copy the single cells and paste them into the cell above it without overwriting it (so text from B4 gets copied and pasted into B3, same from B7 to B6 etc.)

I tried to do it with the following command:

    With Tabelle5
        Set rRange = .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
    End With

    For lRow = 1 To rRange.Rows.Count Step 3
        If lRow = 1 Then
            Set rEveryNth = rRange(lRow, 1)
        Else
            Set rEveryNth = Union(rRange(lRow, 1), rEveryNth)
        End If
    Next lRow
    Application.Goto rEveryNth

    For Each c In Selection
    If c.Value <> "" Then c.Value = c.Value & rEveryNth
    Next

Only problem is that it only pastes the text from the last cell I have and pastes the text into all the other cells, which is not what I want.

Is there any repeat command to select one cell, copy the text, paste it to the cell above without overwriting it? If yes, how do I do it? (I have to do it 20 times in total to have the text copied and pasted correctly)

And for the 2nd part: Any help about selecting every 2nd/3rd row instead of every 2nd/3rd cell in the column?

What I treid so far (thank you for the suggestions) is following:

Dim rRange As Range
Dim rEveryNth As Range
Dim lRow As Long

With Tabelle5
    Set rRange = .Range("B4", .Cells(.Rows.Count, "B").End(xlUp))
End With

For lRow = 1 To rRange.Rows.Count Step 3
    If lRow = 1 Then
        Set rEveryNth = rRange(lRow, 1)
    Else
        Set rEveryNth = Union(rRange(lRow, 1), rEveryNth)
    End If
Next lRow
Application.Goto rEveryNth

Range(rEveryNth.Address).Offset(-1, 0).Value = rEveryNth.Value

End Sub

But it still copies the last cell and pastes it into every other one...

Answer 1

Option Explicit
Sub test()

Dim ws As Worksheet
Dim i As Integer
Dim copyvalue As String
Dim copyvalue2 As String
i = 1

For Each ws In ThisWorkbook.Worksheets
    ActiveWorkbook.Worksheets(i).Select
    copyvalue = Range("B3").Value
    copyvalue2 = Range("B4").Value
    Range("B3") = copyvalue & " " & copyvalue2
    Range("B5").Select
    Selection.EntireRow.Delete
    Range("B6").Select
    Selection.EntireRow.Delete
    i = i + 1
Next ws

End Sub

This will cycle through each worksheet and combine B3 a space and B4 then delete rows 5 and 7. Does this help?

Answer 2

I think this is what you mean:

Dim rRange As Range, c As Range, lRow As Long

With Tabelle5
    Set rRange = .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
End With

For lRow = 1 To rRange.Rows.Count Step 3

    Set c = rRange.Cells(lRow)

    c.Value = c.Value & " " & c.Offset(1,0).Value

Next lRow

You're over-complicating your code by building up those union'ed ranges...

Answer 3

To copy data from a cell and paste it into the cell above, you can try something like this:

currentRange.offset(-1,0).value = currentRange.value

This sets the value of the cell above currentRange to the value of currentRange and doesn't touch the value in currentRange.

For example,

set rng = range("B7") range(rng.address).offset(-1,0).value = rng.value

will set the value in B6 to the value in B7. look up the offset function for more info on it