# Help with a macro

#### jhbendeck

##### New Member
Hello, good evening. Hope all of you are doing great.

In the following thread, I'd like you to help me out with a basic macro where I can move some cells from a default row to another row (the range starts in E2 and ends in AC2, and I need to move from E2 to H2 to A3, B3, C3 and D3), and probably do the same thing for other rows. Here is a picture of how it looks:

In this first picture, the content from F2 to H2 has to be moved to B3, C3 and D3. Then, the content from I2 to K2 has to be moved to B4, C4 and D4 and so on until it reaches 8 entries (as you can see, in the spreadsheet, I had to create 8 rows in order to move that content manually). The limit of the content is AC2.

And this is how it is supposed to look:

I have to execute this task for more than 100 entries, so I would truly appreciate your help with a better way than cutting and pasting this info (I've done this procedure for 2 hours to move more than 20 entries).

Any help would be really appreciated. Thanks in advance.

### Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

##### Well-known Member
Try this Macro:
VBA Code:
Sub Transform()
Dim i As Long, j As Long, Lr As Long, Lc As Long
Lr = Range("A" & Rows.Count).End(xlUp).Row
Lc = Cells(1, Columns.Count).End(xlToLeft).Column

For i = 1 To Lr
If Range("A" & i).Value <> "" Then
For j = 5 To Lc Step 4
Range(Cells(i + (j - 1) / 4, 1), Cells(i + (j - 1) / 4, 4)).Value = Range(Cells(i, j), Cells(i, j + 3)).Value
Next j
i = i + (j - 5) / 4
End If
Next i
Range("E1:AC" & Lr).ClearContents
End Sub

#### jhbendeck

##### New Member
Hello, @maabadi . Thank you for taking your time helping me out. This is how it appeared:

I don't know if there is something to adjust in the variables. I appreciate your help. If you need the file, here it is, sir. Link for the file

Please let me know if you need anything else, in order to help me out. I'd truly appreciate it. You're a life savior.

##### Well-known Member
I don't know if there is something to adjust in the variables.
What is problem? What else you want?
You want Autofit Column or .....

#### jhbendeck

##### New Member

Hello, sir.
I recorded this macro in Excel (This is a dummy's work):

VBA Code:
Sub MacroMove()
'
' MacroMove Macro
'
'
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B3").Select
ActiveSheet.Paste
Range("E3").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B4").Select
ActiveSheet.Paste
Range("E4").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B5").Select
ActiveSheet.Paste
Range("E5").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B6").Select
ActiveSheet.Paste
Range("E6").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B7").Select
ActiveSheet.Paste
Range("E7").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B8").Select
ActiveSheet.Paste
Range("E8").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Cut
Range("B9").Select
ActiveSheet.Paste
Range("E9").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B10").Select
ActiveSheet.Paste
Range("F11").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B12").Select
ActiveSheet.Paste
Range("E12").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B13").Select
ActiveSheet.Paste
Range("E13").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B14").Select
ActiveSheet.Paste
Range("E14").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B15").Select
ActiveSheet.Paste
Range("E15").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B16").Select
ActiveSheet.Paste
Range("E16").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B17").Select
ActiveSheet.Paste
Range("E17").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B18").Select
ActiveSheet.Paste
Range("E18").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B19").Select
ActiveSheet.Paste
Range("F20").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B21").Select
ActiveSheet.Paste
Range("E21").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B22").Select
ActiveSheet.Paste
Range("E22").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B23").Select
ActiveSheet.Paste
Range("E23").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B24").Select
ActiveSheet.Paste
Range("E24").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B25").Select
ActiveSheet.Paste
Range("E25").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B26").Select
ActiveSheet.Paste
Range("E26").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B27").Select
ActiveSheet.Paste
Range("E27").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B28").Select
ActiveSheet.Paste
End Sub

I did this manually, and it look like this:

This procedure has to be done N times in the same spreadsheet, so that the information at the end, can look like this at the end (after the info is organized, I move the numbers to the column E and I copy the content from cells A2, A11, A20, A29, and every 9 rows with the same info contained in those cells):

I dunno if with this, I made myself clear. Thanks for your help and taking the time to help me.

#### Attachments

• 1625197751336.png
160.2 KB · Views: 2
Last edited by a moderator:

#### johnnyL

##### Well-known Member
Hello, sir.
I recorded this macro in Excel (This is a dummy's work):

Sub MacroMove()
'
' MacroMove Macro
'
'
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B3").Select
ActiveSheet.Paste
Range("E3").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B4").Select
ActiveSheet.Paste
Range("E4").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B5").Select
ActiveSheet.Paste
Range("E5").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B6").Select
ActiveSheet.Paste
Range("E6").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B7").Select
ActiveSheet.Paste
Range("E7").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B8").Select
ActiveSheet.Paste
Range("E8").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Cut
Range("B9").Select
ActiveSheet.Paste
Range("E9").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B10").Select
ActiveSheet.Paste
Range("F11").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B12").Select
ActiveSheet.Paste
Range("E12").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B13").Select
ActiveSheet.Paste
Range("E13").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B14").Select
ActiveSheet.Paste
Range("E14").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B15").Select
ActiveSheet.Paste
Range("E15").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B16").Select
ActiveSheet.Paste
Range("E16").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B17").Select
ActiveSheet.Paste
Range("E17").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B18").Select
ActiveSheet.Paste
Range("E18").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B19").Select
ActiveSheet.Paste
Range("F20").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B21").Select
ActiveSheet.Paste
Range("E21").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B22").Select
ActiveSheet.Paste
Range("E22").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B23").Select
ActiveSheet.Paste
Range("E23").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B24").Select
ActiveSheet.Paste
Range("E24").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B25").Select
ActiveSheet.Paste
Range("E25").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B26").Select
ActiveSheet.Paste
Range("E26").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B27").Select
ActiveSheet.Paste
Range("E27").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("B28").Select
ActiveSheet.Paste
End Sub

I did this manually, and it look like this:
Did that code do what you wanted it to do?

##### Well-known Member

Try this:
VBA Code:
Sub Transform()
Dim i As Long, j As Long, Lr As Long, Lc As Long, S As Long, E As Long, K As Long, P As Boolean
Lr = Range("A" & Rows.Count).End(xlUp).Row
Lc = Cells(1, Columns.Count).End(xlToLeft).Column
On Error GoTo ErrHandler
For i = 2 To Lr
If Range("A" & i).Value <> "" Then
K = i
S = 6
For j = 5 To Lc
If Left(Cells(i, j).Value, 4) = "http" Then
E = j + 1
K = K + 1
Range(Cells(K, 2), Cells(K, 4)).Value = Range(Cells(i, S), Cells(i, E)).Value
Cells(K, 5).Value = Cells(K - 1, 5).Value
End If
If IsNumeric(Cells(i, j).Value * 1) Then S = j + 1
TypeMismatch:
Next j

End If
ErrHandler:
If Err = 13 Then Resume TypeMismatch
Next i
Range("F1:AC" & Lr).ClearContents
End Sub

#### jhbendeck

##### New Member
Did that code do what you wanted it to do?
Hello, sir. Good morning. Nice to meet you.

Well, the code I pasted in this thread was a manual macro I recorded, but the pattern you see there is the one I am trying to simplify in one single code for many entries of the spreadsheet (as you can see, I am attempting to move a set of three cells from one row to a new row, and those set ranges are between F and H, I and K, L and N, until AC).

If there's any additional information you require to assist me, I'd truly appreciate it.

#### jhbendeck

##### New Member
Try this:
VBA Code:
Sub Transform()
Dim i As Long, j As Long, Lr As Long, Lc As Long, S As Long, E As Long, K As Long, P As Boolean
Lr = Range("A" & Rows.Count).End(xlUp).Row
Lc = Cells(1, Columns.Count).End(xlToLeft).Column
On Error GoTo ErrHandler
For i = 2 To Lr
If Range("A" & i).Value <> "" Then
K = i
S = 6
For j = 5 To Lc
If Left(Cells(i, j).Value, 4) = "http" Then
E = j + 1
K = K + 1
Range(Cells(K, 2), Cells(K, 4)).Value = Range(Cells(i, S), Cells(i, E)).Value
Cells(K, 5).Value = Cells(K - 1, 5).Value
End If
If IsNumeric(Cells(i, j).Value * 1) Then S = j + 1
TypeMismatch:
Next j

End If
ErrHandler:
If Err = 13 Then Resume TypeMismatch
Next i
Range("F1:AC" & Lr).ClearContents
End Sub
Hello, sir. Good morning.

I think that should do it and you're the man! After executing the macro, this was the result (which might help me to do this faster and more organized):

All I need to do is to clean the value in Peso Inicial, move the values from D3:D10 to E3:E10 and copy the cell in A2 in the range from A3-A10. But that has been really useful.

Thank you so much!

##### Well-known Member
This is different than file of uploaded format. I write macro based on.
Try this:
VBA Code:
Sub Transform()
Dim i As Long, j As Long, Lr As Long, Lc As Long, S As Long, E As Long, K As Long, P As Boolean
Lr = Range("A" & Rows.Count).End(xlUp).Row
Lc = Cells(1, Columns.Count).End(xlToLeft).Column
On Error GoTo ErrHandler
For i = 2 To Lr
If Range("A" & i).Value <> "" Then
K = i
S = 6
For j = 5 To Lc
If Left(Cells(i, j).Value, 4) = "http" Then
E = j + 1
K = K + 1
Range(Cells(K, 2), Cells(K, 3)).Value = Range(Cells(i, S), Cells(i, E -1)).Value
Cells(K, 5).Value = Cells(i, E).Value
Cells(K, 4).Value = Cells(K-1, 4).Value
End If
If IsNumeric(Cells(i, j).Value * 1) Then S = j + 1
TypeMismatch:
Next j
End If
ErrHandler:
If Err = 13 Then Resume TypeMismatch
Next i
Range("F1:AC" & Lr).ClearContents
End Sub

Replies
11
Views
174
Replies
2
Views
106
Replies
2
Views
351
Replies
5
Views
181
Replies
10
Views
161

1,147,476
Messages
5,741,349
Members
423,656
Latest member
Medrok2021

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back