View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Claus Busch Claus Busch is offline
external usenet poster
 
Posts: 3,872
Default Copying many columns into one column

Hi John,

Am Thu, 16 Nov 2017 12:16:40 -0800 (PST) schrieb :

Hello everyone, I have Lastname, Firstname information in the cell ranges below in a spreadsheet named "Position Control."

A9:A38
C9:C38
E9:E38
G9:G38
I9:I38
MK9:K38
M9:M38
O9:O38
Q9:Q38
S9:S38

Not every cell in the above range is utilized. Some ranges may have 5 names in it. Another may have 12 names and so on. The question is how can I get the data from each of these ranges copied into column A of spreadsheet "Team Members" and sorted alphabetically? The end result of Column A in spreadsheet "Team Members" is one long list of Lastname, Firstnames. After that operation is complete I would like to do something to lock the Position Control spreadsheet so the names cannot be changed.


write some additional lines into the existing code:

Sub Test()
Dim rng1 As Range, rng2 As Range
Dim dest As Range
Dim i As Integer

Set rng1 = Sheets("Input").Range("A24:A53,C24:C53,F24:F53," _
& "H24:H53,K24:K53,M24:M53,P24:P53,R24:R53,U24:U53,W 24:W53")

Set rng2 = Sheets("Position Control").Range("A9:A38,C9:C38,E9:E38," _
& "G9:G38,I9:I38,K9:K38,M9:M38,O9:O39,Q9:Q38,S9:S38" )

For i = 1 To rng1.Areas.Count
With rng2.Areas(i)
.Value = rng1.Areas(i).Value
.Sort key1:=.Cells(1), order1:=xlAscending, Header:=xlNo
End With
Next
rng2.Cells.Locked = True
Sheets("Position Control").Protect

With Sheets("Team Members")
For i = 1 To rng2.Areas.Count
Set dest = IIf(Len(.Range("A1")) = 0, .Range("A1"), .Cells(.Rows.Count, 1).End(xlUp)(2))
dest.Resize(rng2.Areas(i).Rows.Count).Value = rng2.Areas(i).Value
Next
.Range("A:A").Sort key1:=.Range("A1"), order1:=xlAscending,
Header:=xlNo
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016