Select and copy only specific cells.

[harleyskater]

I have a problem where I was given a list of companies in an excel sheet that are formatted horribly.

3727	Memento Funeral Chapel	Mailing:	5201 Lakeshore Drive	Business Unit:	Canada
Physical:	5201 Lakeshore Drive		Bonnyville, AB T9N 1X7   	Managing Dir:	John Gordon
	Bonnyville, AB T9N 1X7   	Express:		Market Dir:	Gordon Allert
Phone:	(780) 826-3113		,  	Market Mgr:	David Grambo
Fax:	(780) 826-3400			Location Mgr:	Jeffrey Thackeray

does anyone have any code that would format that in a usable way? Like name, mailing address, city/state/zip, phone, fax

there are about 15000 mailing labels i have to make from this it could take FOOREEeevvVVeeerrr haha

 

[chergh]

Can you post a sample of the spreadsheet showing the format you have received and an example of how you would like it to look.

 

[harleyskater]

Example

I will attach an example.

The list is reallllly long : ) I am learning this as I go. I do not deal with excel very often. thank you

 

[harleyskater]

I might have a more simple idea for a solution.

if there is a way to copy and paste the rows into 1 row.

example--
cut row 1 and paste to new row 1
cut row 2 append to end of row 1
cut row 3 append to end of row 1
cut row 4 append to end of row 1
cut row 5 append to end of row 1
cut row 6 and paste to new row 2
cut row 7 append to end of row 1
cut row 8 append to end of row 1
cut row 9 append to end of row 1
cut row 10 append to end of row 1

If that was possible, then you could just delete the columns you don't need and move columns to the places you needed them : )!!!

 

[harleyskater]

Sub Macro1()
'
' Macro1 Macro
' copy rows
'
' Keyboard Shortcut: Ctrl+r
'
    Range("A2:F2").Select
    Selection.Copy
    Range("H2").Select
    ActiveSheet.Paste
    Range("A3:F3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H3").Select
    ActiveSheet.Paste
    Range("A4:F4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H4").Select
    ActiveSheet.Paste
    Range("A5:F5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H5").Select
    ActiveSheet.Paste
    Range("A6:F6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H6").Select
    ActiveSheet.Paste
End Sub

hmm thats the best i could come up with. I don't know enough to loop or have nonspecific cell haha ;*(

 

[harleyskater]

haha bad attempt number 1 : ) im going to go try again!

Sub Macro1()
'
' Macro1 Macro
' copy rows
'
' Keyboard Shortcut: Ctrl+r
'
Dim wb As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim Rng As Range
Dim i As Integer
Dim j As Integer

Set wb = ThisWorkbook
Set ws = wb.Worksheets("DetailOperDir")
Set ws2 = wb.Worksheets("Sheet1")

        Do
            For i = 1 To 5
                
            
                ws.Rows(i).EntireRow.Cut
                ws2.Rows(j).Select
                ActiveSheet.append
                
            Next i
        Next j

    Loop

End Sub

 

[harleyskater]

ok so i wrote something I think is working haha my excel is going crazy haha i will post what i did so you guys can have a giggle haha a

 

[harleyskater]

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+t
'

Dim i As Integer

Do
i = i + 1
Range("A2:F2").Select
Selection.Copy
Sheets("Sheet1").Select
Range("A" & i).Select
ActiveSheet.Paste
Sheets("DetailOperDir").Select
Range("A3:F3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("G" & i).Select
ActiveSheet.Paste
Sheets("DetailOperDir").Select
Range("A4:F4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("M" & i).Select
ActiveSheet.Paste
Sheets("DetailOperDir").Select
Range("A5:F5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("S" & i).Select
ActiveSheet.Paste
Sheets("DetailOperDir").Select
Range("A6:F6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("Y" & i).Select
ActiveSheet.Paste
Sheets("DetailOperDir").Select
Rows("2:6").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

Loop

End Sub

 

[ptm0412]

Just only function!

If your data has the frequency of 5 rows once a record, use the function like the attachment. I've just done for 5 or 6 fields, then you finish them.