macro to cut data from a row starting from column p and paste it into the row below at d

[Abbes]

macro to cut data from a row starting from column p and paste it into the row below at d if it is empty

Dear Guys I have a list with names of different cities around the world for over 3000 city.

I need a VBA macro code to be able to cut and paste as shown in the attached file.

note: in the attached file sheet1 is (before) sheet2 is (after)


thanks for your help.



macro to cut data from a row starting from column p and paste it into the row below at d if it is empty

I usually use MS OFFICE 2010, 2013. But for now I am using office 2007

[Marc L]

Paste next demonstration to worksheet module :

Sub Demo() 
     Const C = """" 
       Dim Rg As Range, R& 
       Application.ScreenUpdating = False 
    Do Until Cells(R + 1, 1).Value = "" 
            R = R + 1 
       Set Rg = Cells(R, Columns.Count).End(xlToLeft) 
        If Rg.Column > 16 Then 
            Range(Cells(R, 16), Rg).Cut Cells(R + 1, 4) 
            Cells(R, 16).Value = C 
        ElseIf Rg.Value <> C Then 
               Rg(1, 2).Value = C 
        End If 
    Loop 
       Set Rg = Nothing 
       Application.ScreenUpdating = True 
End Sub  

Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !

[mike7952]

Maybe it's just my Excel, but to copy the code and paste into the module doesn't paste right. I would guess because its in PHP Code Tags.

Paste next demonstration to worksheet module :

Sub Demo()
     Const C = """"
       Dim Rg As Range, R&
       Application.ScreenUpdating = False
    Do Until Cells(R + 1, 1).Value = ""
            R = R + 1
       Set Rg = Cells(R, Columns.Count).End(xlToLeft)
        If Rg.Column > 16 Then
            Range(Cells(R, 16), Rg).Cut Cells(R + 1, 4)
            Cells(R, 16).Value = C
        ElseIf Rg.Value <> C Then
               Rg(1, 2).Value = C
        End If
    Loop
       Set Rg = Nothing
       Application.ScreenUpdating = True
End Sub  

Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !

[mike7952]

Paste next demonstration to worksheet module :

Sub Demo()
     Const C = """"
       Dim Rg As Range, R&
       Application.ScreenUpdating = False
    Do Until Cells(R + 1, 1).Value = ""
            R = R + 1
       Set Rg = Cells(R, Columns.Count).End(xlToLeft)
        If Rg.Column > 16 Then
            Range(Cells(R, 16), Rg).Cut Cells(R + 1, 4)
            Cells(R, 16).Value = C
        ElseIf Rg.Value <> C Then
               Rg(1, 2).Value = C
        End If
    Loop
       Set Rg = Nothing
       Application.ScreenUpdating = True
End Sub  

Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !

I had to put into the normal "

Please Login or Register  to view this content.

" Tags

Please Login or Register  to view this content.

[Marc L]

No issue on my side with two different Excel and Windows versions …

Both with Firefox …

[mike7952]

@Marc L

I'm using Windows 10 with Excel 2016. If I copy the code within the PHP code tags, its acting weird in the module and highlighting linesred. I back it all out and still can not get it to compile. Strange...

[Marc L]

Which webbrowser ? Internet Explorer ?!

[mike7952]

Yes Explorer

[Marc L]

As since a couple of days there are some issues between this site and Internet Explorer,
see this thread and another one…

[mike7952]

Ah I see, thanks my friend.

[Marc L]

Thanks for your warning as now I maybe understand why I've no answer after my codes !

[mike7952]

No problem, Your Code in this thread does work for me. Just not able to copy the Codes inside PHP code tags using IE and paste correctly into excel.

[Marc L]

Maybe by pasting to Notepad then with a new copy from Notepad …

PHP code tags are usefull to see code even if not logged to forum.

[mike7952]

Nope, just tried that. The only way I can get it to work is to reply to your post by "Reply With Quote" and then copy the plain code txt from inside the PHP code tags

[Marc L]

So weird …

[mike7952]

I was thinking maybe the[Indent][Indent] tags had something to do with it but nope lol

[Marc L]

Do you have same issue with this thread or with that another one ?

[mike7952]

Yes sir, Both of those threads I can not copy and paste into the module and get the code to compile with IE Windows 10

[Marc L]

Ok, thanks !

[Abbes]

Dear Marc the Code diid work but just for the first row it didn't contiunue till the end of the sheet.

If I am not clear with what I wrote hopefully the example sheet can explain what I want.

Many thanks in advance.

[Marc L]

Try my code with your attachment, as it works on my side …

[Abbes]

Thanks Marc I think i missed some thing while copying the code it works perfectly.

May i ask you to write me some eplanations to the code to understand how it works so I can improve my knowledege.

Many thanks.

[Marc L]

If last data cell of a row is after column P then range from column P until last cell is moved a row under …

Place text cursor on a statement, hit F1 key and read : all is in VBA inner help !