Copy and Paste rows but changing one of the values

[pausard]

Hey there! I'm pretty new to VBA so right now I am very confused.
I have a spreadsheet with a lot of information for individuals with a lot of columns but the ones i care about are: Name, Surname, Company, and Property Address.
What I have to do is use a macro(button) to move them to another spreadsheet so that there's Name, Surname, Company and Address in columns A-D. The issue is, some people have more than one address so their other properties are in columns E-K. And some people have no address. What I want to do is, if a certain person has no address, delete the line. But if they have more than one, then create a new line right underneath with the same Name, Surname and Company, but just add the second address.

So, if some guy called Paul Smith has 3 addresses it will look like this:
[TABLE="width: 254"]
<colgroup><col><col><col><col></colgroup><tbody>[TR]
[TD]Paul [/TD]
[TD]Smith[/TD]
[TD]General Motors[/TD]
[TD]ADDRESS1[/TD]
[/TR]
[TR]
[TD]Paul [/TD]
[TD]Smith[/TD]
[TD]General Motors[/TD]
[TD]ADDRESS2[/TD]
[/TR]
[TR]
[TD]Paul [/TD]
[TD]Smith[/TD]
[TD]General Motors[/TD]
[TD]ADDRESS3
[/TD]
[/TR]
</tbody>[/TABLE]

I've tried everything I can think of but nothing is working. It doesn't seem like that hard of a problem for what one can do with VBA but my brain is fried and I don't know how to work through it.
Does anyone have any advice on this? Or even, any code?

Thanks so much!

 

[footoo]

Do you mean that you already have the destination sheet with the A:D data and with addresses for some people in some or all of columns E:K ?

 

[pausard]

So i have the destination for A-C, but now I have to find a way to get rid of the people with no addresses (no info) in D-K and to create new lines for those with more than one address

 

[footoo]

So i have the destination for A-C, but now I have to find a way to get rid of the people with no addresses (no info) in D-K and to create new lines for those with more than one address

You have not answered my question.
Do you have all the information on the destination sheet and you just to rearrange it?

Also, is it OK to sort all the data by name?

 

[footoo]

Assuming "yes" answers to my previous post, try this :

Sub FT()
Dim rng As Range, cel As Range, c%
On Error Resume Next
[D:D].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Set rng = Range([E2], Cells(Rows.Count, "E").End(xlUp)).SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If rng Is Nothing Or rng.Address = "$E$1" Then Exit Sub
For Each cel In rng
    c = Cells(cel.Row, Columns.Count).End(xlToLeft).Column
    If c > 4 Then
        Cells(Rows.Count, "D").End(xlUp)(2).Resize(c - 4).Value = Application.Transpose(cel.Resize(, c - 4))
        Cells(cel.Row, "A").Resize(, 3).Copy Cells(Rows.Count, "A").End(xlUp)(2).Resize(c - 4)
    End If
Next
[E:K].ClearContents
Range("A1:D" & Cells(Rows.Count, "D").End(xlUp).Row).Sort Key1:=[B1], _
    Key2:=[A1], Order1:=xlAscending, Header:=xlYes
End Sub

 

[pausard]

Oh i see what you are asking. No i don't have the info on the destination sheet. It's a blank sheet.
And yeah it can be sorted by the name

 

[footoo]

Oh i see what you are asking. No i don't have the info on the destination sheet. It's a blank sheet.
And yeah it can be sorted by the name

Post some sample data.

 

[pausard]

Hey, so the sample data is below. I can't actually post the original data since it's private but this is what it would look like. As you can see there are many columns, but I only care for the ones that say Name, Surname, Company and Address. If there is no address (row 2) then it can be deleted in the new spreadsheet, but if there is more than one address (row 1), then one line for every address has to be created with the same Name, Surname and Company.

[TABLE="width: 1132"]
<colgroup><col><col><col><col><col><col><col span="2"><col><col><col span="5"></colgroup><tbody>[TR]
[TD]Name[/TD]
[TD]Surname[/TD]
[TD]Spouse Name[/TD]
[TD]Spouse Surname[/TD]
[TD]Company[/TD]
[TD]Income[/TD]
[TD]Address 1[/TD]
[TD]Address 2[/TD]
[TD]Address 3[/TD]
[TD]Address 4 [/TD]
[TD]Address 5[/TD]
[TD]Address 6[/TD]
[TD]Address 7[/TD]
[TD]Address 8[/TD]
[TD]Address 9[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD]Smith[/TD]
[TD]Mary[/TD]
[TD]Winstead[/TD]
[TD]General Motors[/TD]
[TD="align: right"]100000[/TD]
[TD](Address1)[/TD]
[TD](Address2)[/TD]
[TD](Address 3)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]James[/TD]
[TD]May[/TD]
[TD]Jessica[/TD]
[TD]Jackson[/TD]
[TD]JP Morgan[/TD]
[TD="align: right"]50000[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Peter[/TD]
[TD]Jackson[/TD]
[TD]Amy[/TD]
[TD]Simpson[/TD]
[TD]Hilton Hotels[/TD]
[TD="align: right"]70000[/TD]
[TD](Address1)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="width: 1102"]
<colgroup><col><col><col><col><col><col><col span="2"><col><col><col span="3"><col><col></colgroup><tbody></tbody>[/TABLE]

 

[footoo]

Select the source sheet then :

Sub FT()
Dim rng As Range, cel As Range, c%
Sheets("Source Sheet").Copy After:=Sheets("Source Sheet") 'Change sheet name to actual name
[C:D,F:F].Delete
On Error Resume Next
[D:D].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Set rng = Range([E2], Cells(Rows.Count, "E").End(xlUp)).SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If rng Is Nothing Or rng.Address = "$E$1" Then Exit Sub
For Each cel In rng
    c = Cells(cel.Row, Columns.Count).End(xlToLeft).Column
    Cells(Rows.Count, "D").End(xlUp)(2).Resize(c - 4).Value = Application.Transpose(cel.Resize(, c - 4))
    Cells(cel.Row, "A").Resize(, 3).Copy Cells(Rows.Count, "A").End(xlUp)(2).Resize(c - 4)
Next
[E:K].ClearContents
Range("A1:D" & Cells(Rows.Count, "D").End(xlUp).Row).Sort Key1:=[B1], _
    Key2:=[A1], Order1:=xlAscending, Header:=xlYes
End Sub

 

[pausard]

Oh my that works beautifully! Thank you so much!!