Concatenating and Copying columns from 30 sheets

  • Thread starter Thread starter Zak
  • Start date Start date
Z

Zak

Hi,

I have 30 sheets and for each of the 30 sheets firstly i would like to
concatenate columns C and D (in each sheet) then get the results of that
(which would be displayed in column E) and then this column E to be copied
and pasted in a new sheet - so all column E's in the 30 sheets to be pasted
in 1 new sheet directly below one another. Is this do-able?

summary-
1-concatenate columns C & D in each of the 30 sheets
2-the results of this concatenation to be displayed in column E
3-this column E to be copied in each of the 30 sheets and pasted in a new
sheet - each column directly under one another.

please reply at your earliest possible convinience.

thanks a lot.
 
Sub CopyESum()
Dim wS As Worksheet, wSTotal As Worksheet
Dim lRow As Long, aRow As Long, sRow As Long

Set wSTotal = Worksheets.Add

wSTotal.Name = "Summary"
sRow = 1

For Each wS In Worksheets
If wS.Name <> "Summary" Then
With wS
For aRow = 1 To .Cells(.Rows.Count, "C").End(xlUp).Row.Cells(aRow, 5) = _
Trim(.Cells(aRow, 3)) & Trim(.Cells(aRow, 4))
Next
.Range(.Cells(1, 5), .Cells(aRow, 5)).Copy _
Destination:=wSTotal.Cells(sRow, 1)
sRow = sRow + aRow - 1
End With
End If
Next
End Sub
 
I tried running it and it reported an error and highlights this line:

For aRow = 1 To .Cells(.Rows.Count, "C").End(xlUp).Row.Cells(aRow, 5) = _
Trim(.Cells(aRow, 3)) & Trim(.Cells(aRow, 4))

its not a problem if there is something already in column E right? i would
assume the macro would move along whatever is in the column and replace it
with the results of the concatentation.

please advise.

thanks.
 
Should be two lines as follows......

For aRow = 1 To .Cells(.Rows.Count, "C").End(xlUp).Row
.Cells(aRow, 5) = Trim(.Cells(aRow, 3)) & Trim(.Cells(aRow, 4))

No it writes in column E, as per your OP. You will have to add a move data
process, what if there is stuff in column F, G, H etc. how far do you move
it?

--

Regards,
Nigel
(e-mail address removed)
 
If you do not want to write it into column E, why not just write it into the
summary....

Sub CopyESum2()
Dim wS As Worksheet, wSTotal As Worksheet
Dim lRow As Long, aRow As Long, sRow As Long

Set wSTotal = Worksheets.Add

wSTotal.Name = "Summary"
sRow = 1
For Each wS In Worksheets
If wS.Name <> "Summary" Then
With wS
For aRow = 1 To .Cells(.Rows.Count, "C").End(xlUp).Row
wSTotal.Cells(sRow, 1) = Trim(.Cells(aRow, 3)) & Trim(.Cells(aRow, 4))
sRow = sRow + 1
Next
End With
End If
Next
End Sub


--

Regards,
Nigel
(e-mail address removed)
 
Hi, that has worked but i realised when it concatenated it didnt put a space
between the words - sorry i didnt specify that. It is first name and surname
that i am combining so would like a space can you please advise?

Also, columns until Y-Z have info in them and i realised when i run the
macro it replaces the current contents of the column E, so can you please put
in macro so it moves it only one column along - even if it was to insert a
new column after D (which would obviously be called E) and then to put the
result of the concatenation in that - so it doesnt replace any info.. that
would be very useful.

finally, can i put in a statement in the macro to delete all blank cells in
summary sheet column A, as the result brings back names concatenated but it
has lots of blank cells in it too.

i really appreciate your prompt reply. really helped me a lot.
 
SORRY, i have got it to delete the blank cells i just need a space in the
concatenate bit.

thanks so much.
 
I suppose that works better - so it just concatenates in the summary sheet
-GREAT THANKS!. can i insert a space between the C&D concatenation? the last
statement in the macro should be to delete all blanks in column A. i have
this formula but im unsure of how to combine it with your one..it keeps
reporting error.

On Error Resume Next
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange


THANKS ALOT.
 
It's always better to specify requirements more fully at the start, saves
rework, but here is the solution.

PS. Thought about duplicates in the list??

Sub CopyESum3()
Dim wS As Worksheet, wSTotal As Worksheet
Dim lRow As Long, aRow As Long, sRow As Long

Set wSTotal = Worksheets.Add

wSTotal.Name = "Summary"
sRow = 1

For Each wS In Worksheets
If wS.Name <> "Summary" Then
With wS
.Columns("E:E").Insert shift:=xlToRight
For aRow = 1 To .Cells(.Rows.Count, "C").End(xlUp).Row
.Cells(aRow, 5) = Trim(.Cells(aRow, 3)) & " " & Trim(.Cells(aRow, 4))
Next
.Range(.Cells(1, 5), .Cells(aRow, 5)).Copy _
Destination:=wSTotal.Cells(sRow, 1)
sRow = sRow + aRow - 1
End With
End If
Next
With wSTotal
For aRow = sRow To 1 Step -1
If Len(Trim(.Cells(aRow, 1))) = 0 Then .Rows(aRow).EntireRow.Delete
shift:=xlUp
Next
End With
End Sub




--

Regards,
Nigel
(e-mail address removed)
 
Hi, i received an email that i had a response but i see no response when i
look in forum.

please advise.
 
Sorry, i dont know if i am being blind but i cant seem to see the bit about
inserting a space between C & D when concatenated, thats what i need to know.
i am looking at all other responses to see where you say you have linked the
response but i only see our old posts.

sorry to be such a pain!
 
This is a copy.......of the earlier trail, it includes the space, and
removal of blank rows on the summary sheet......
(watch out for word wraps in the code)

==================================================
It's always better to specify requirements more fully at the start, saves
rework, but here is the solution.

PS. Thought about duplicates in the list??

Sub CopyESum3()
Dim wS As Worksheet, wSTotal As Worksheet
Dim lRow As Long, aRow As Long, sRow As Long

Set wSTotal = Worksheets.Add

wSTotal.Name = "Summary"
sRow = 1

For Each wS In Worksheets
If wS.Name <> "Summary" Then
With wS
.Columns("E:E").Insert shift:=xlToRight
For aRow = 1 To .Cells(.Rows.Count, "C").End(xlUp).Row
.Cells(aRow, 5) = Trim(.Cells(aRow, 3)) & " " & Trim(.Cells(aRow, 4))
Next
.Range(.Cells(1, 5), .Cells(aRow, 5)).Copy _
Destination:=wSTotal.Cells(sRow, 1)
sRow = sRow + aRow - 1
End With
End If
Next
With wSTotal
For aRow = sRow To 1 Step -1
If Len(Trim(.Cells(aRow, 1))) = 0 Then .Rows(aRow).EntireRow.Delete
shift:=xlUp
Next
End With
End Sub



--

Regards,
Nigel
(e-mail address removed)
 
Hi,

i do apologise for any inconvinience i have caused you.. but that has worked
a treat.. really appreciate your prompt replies.

You mentioned duplicates - i dont expect there to be any duplicates because
one person can only appear in one of the 30 sheets once but incase the
unlikely happens - is there a problem that this can cause? i would assume if
will concatenate and put in the summary sheet anyways, right?

the duplicate will later be picked up as this list will be used for a
lookup. i didnt know how to do a lookup from the column E in each of the 30
sheets into 1 column in another sheet (is this even possible?) so that why i
thought i would get all the column E's from the 30 sheets, put them in 1 new
sheet that you have called summary and then my colleague would manually do a
vlookup from that column into another existing column. is there a way that
this bit can be automated?

i thank you sincerely for your help.
 
Back
Top