Loop through data, copy various values to new row on another tab

[sserc]

Worksheet1

LastName

FirstName

Code

ID

E

Group

Address

H

Group2

Address2

K

Group3

Address3

Smith

John

01, 03

123456

Place1

123 Main St.

Jones

Fred

06

852547

Place1

123 Main St.

Place2

345 Water St.

Place3

567 High St.

White

Barb

03, 123, 04

258787

Place1

123 Main St.

Place2

345 Water St.

Collins

Susan

06, 03

345214

Place2

345 Water St.

Place4

987 1st St.

<tbody>
</tbody>

Worksheet2

LastName	FirstName	Code	ID	Group	Address
Smith	John	01, 03	123456	Place1	123 Main St.
Jones	Fred	06	852547	Place1	123 Main St.
White	Barb	03, 123, 04	258787	Place1	123 Main St.
Collins	Susan	06, 03	345214	Place2	345 Water St.

<tbody>
</tbody>

I have original data structured like Worksheet1 above. In this example, columns E,H, and K are other data that is irrelevant. The Group field is a primary location, Group2 and Group3 are secondary and tertiary locations. I have already pulled out the data I need for the primary location into Worksheet2 (as shown above). I need to loop through the Group2 and then Group3 columns to find rows that have an existing value. If there is a value in Group2 or Group3, then copy specific cells to the bottom of the list on Worksheet2. The number of rows in Worksheet1 and Worksheet2 is always variable (there will be many future spreadsheets like this).

So - loop through Group2 column, when a value is found, copy the LastName, FirstName, Code, ID, Group2, and Address2 to the bottom of the Worksheet2 list (Group2 and Address2 will now appear in the Group and Address columns). Then do the same for the Group3 column.

The end results will look like this:

Worksheet2

LastName	FirstName	Code	ID	Group	Address
Smith	John	01, 03	123456	Place1	123 Main St.
Jones	Fred	06	852547	Place1	123 Main St.
White	Barb	03, 123, 04	258787	Place1	123 Main St.
Collins	Susan	06, 03	345214	Place2	345 Water St.
Jones	Fred	06	852547	Place2	345 Water St.
White	Barb	03, 123, 04	258787	Place2	345 Water St.
Collins	Susan	06, 03	345214	Place4	987 1st St.
Jones	Fred	06	852547	Place3	567 High St.

<tbody>
</tbody>

Thank you for any help you can give me on this!

 

[Fluff]

Hi & welcome to MrExcel
How about

Sub Copydata()
   Dim lr As Long
   
   With Sheets("sheet1")
      lr = .Range("A" & Rows.count).End(xlUp).row
      .Range("E:E").EntireColumn.Hidden = True
      .Range("A1:G" & lr).SpecialCells(xlVisible).Copy Sheets("sheet2").Range("A1")
      .Range("F:H").EntireColumn.Hidden = True
      .Range("A2:J" & lr).SpecialCells(xlVisible).Copy Sheets("Sheet2").Range("A" & Rows.count).End(xlUp).Offset(1)
      .Range("I:K").EntireColumn.Hidden = True
      .Range("A2:M" & lr).SpecialCells(xlVisible).Copy Sheets("Sheet2").Range("A" & Rows.count).End(xlUp).Offset(1)
      .Range("E:K").EntireColumn.Hidden = False
   End With
   Sheets("Sheet2").Range("F:F").SpecialCells(xlBlanks).EntireRow.Delete
End Sub

 

[sserc]

Hi & welcome to MrExcel
How about

Sub Copydata()
   Dim lr As Long
   
   With Sheets("sheet1")
      lr = .Range("A" & Rows.count).End(xlUp).row
      .Range("E:E").EntireColumn.Hidden = True
      .Range("A1:G" & lr).SpecialCells(xlVisible).Copy Sheets("sheet2").Range("A1")
      .Range("F:H").EntireColumn.Hidden = True
      .Range("A2:J" & lr).SpecialCells(xlVisible).Copy Sheets("Sheet2").Range("A" & Rows.count).End(xlUp).Offset(1)
      .Range("I:K").EntireColumn.Hidden = True
      .Range("A2:M" & lr).SpecialCells(xlVisible).Copy Sheets("Sheet2").Range("A" & Rows.count).End(xlUp).Offset(1)
      .Range("E:K").EntireColumn.Hidden = False
   End With
   Sheets("Sheet2").Range("F:F").SpecialCells(xlBlanks).EntireRow.Delete
End Sub

This will do the trick. Thank you so much!

 

[Fluff]

You're welcome

 

[RasGhul]

Very nice Fluff

I'm still green with VBA but managed to achieve the goal...

Dim lastrow As Long, lastrow1 As Long, erow As Long

'Group2 Look
lastrow = Sheets("Sheet1").Cells(Rows.Count, 9).End(xlUp).Row
    'Group3 Look
    lastrow1 = Sheets("Sheet1").Cells(Rows.Count, 12).End(xlUp).Row
    
    Application.ScreenUpdating = False
        
'1,2,3,4,9,10
For i = 2 To lastrow
    If Sheets("Sheet1").Cells(i, "I").Value <> "" Then
    
    Sheets("Sheet1").Cells(i, 1).Copy
        erow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 1)
    Sheets("Sheet1").Cells(i, 2).Copy
    Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 2)
    Sheets("Sheet1").Cells(i, 3).Copy
    Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 3)
    Sheets("Sheet1").Cells(i, 4).Copy
    Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 4)
    Sheets("Sheet1").Cells(i, 9).Copy
    Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 5)
    Sheets("Sheet1").Cells(i, 10).Copy
    Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 6)
End If


Next i
        '1,2,3,4,12,13
        For j = 2 To lastrow1
            If Sheets("Sheet1").Cells(j, "L").Value <> "" Then
            
            Sheets("Sheet1").Cells(j, 1).Copy
                erow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 1)
            Sheets("Sheet1").Cells(j, 2).Copy
            Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 2)
            Sheets("Sheet1").Cells(j, 3).Copy
            Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 3)
            Sheets("Sheet1").Cells(j, 4).Copy
            Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 4)
            Sheets("Sheet1").Cells(j, 12).Copy
            Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 5)
            Sheets("Sheet1").Cells(j, 13).Copy
            Sheets("Sheet1").Paste Destination:=Sheets("Sheet2").Cells(erow, 6)
        End If
 
        Next j


Application.CutCopyMode = False


Application.ScreenUpdating = True