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

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

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 2

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

Answer 3

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?