Help with a macro

J

jhbendeck

New Member
Joined
Jun 26, 2021
Messages
6
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
  2. Web
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:

1624757051796.png


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:

1624757085147.png


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

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
Welcome to MrExcel Message Borad.
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
 
Upvote 0
Hello, @maabadi . Thank you for taking your time helping me out. This is how it appeared:

1625188152422.png


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. :)
 
Upvote 0
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:

1625197996536.png


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):

1625198232475.png


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

Attachments

  • 1625197751336.png
    1625197751336.png
    160.2 KB · Views: 8
Last edited by a moderator:
Upvote 0
jhbendeck said:
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:
Click to expand...
Did that code do what you wanted it to do?
 
Upvote 0
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
 
Upvote 0
johnnyL said:
Did that code do what you wanted it to do?
Click to expand...
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.

Thanks in advance.
 
Upvote 0
maabadi said:
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
Click to expand...
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):

1625231577564.png

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!
 
Upvote 0
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
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

B
  • Solved
VBA to Move Rows Based on Status in Excel
Replies
3
Views
649
Alex Blakenburg
A
KlausW
  • Locked
  • Question Question
VBA code to move picture from on sheets to another sheet
Replies
1
Views
61
Fluff
Fluff
R
  • Question Question
VBA for Cut, move, paste, delete rows
Replies
6
Views
303
RForster6
R
E
  • Solved
Macro to print a table filling from a sheet then move to the next row on the sheet
Replies
3
Views
177
Peter_SSs
Peter_SSs
P
  • Question Question
Ordering and Macros
Replies
0
Views
189
pledge8236
P

Forum statistics

Threads
1,224,818
Messages
6,181,150
Members
453,021
Latest member
Justyna P

Share this page

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top