EXCEL1: Copy from multiple sheets (26), PASTE to 1 sheet from 26 sheets

aacod

aacod

Well-known Member
Joined
Mar 20, 2009
Messages
667
I have a workbook with 26 sheets, labelled A to Z. Column A in all the sheets have names from rows A6:A35.

I need a macro or a code to extract all the names from each of the 26 sheets and paste it to a new sheet 'Names' under column A, such that names starting with 'B' paste under all the names 'A' and so forth till 'Z'.
Thanks .
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
Try

Code: 
Sub AppendData()
Dim ws As Worksheet, LR As Integer
Application.ScreenUpdating = False
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Names"
For Each ws In ThisWorkbook.Worksheets
    With ws
        If .Name <> "Names" Then .Range("A6:A35").Copy Destination:=Sheets("Names").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End With
Next ws
With Worksheets("Names")
    .Rows(1).Delete
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A1:A" & LR).Sort Key1:=Range("A1"), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Thank Peter & Jeff.

I have used Peter's code which meets my need right now.
Jeff, I will try the codes from the link that has been provided by you.
 
Upvote 0
Peter,

Would apreciate if you could add a function to the following code to DELETE all Blank ROWSfrom 'NAMES' sheet, and also if there is no text in cloumn 'A' Delete the whole ROW from 'NAMES' Sheet.


HTML: 
Sub AppendData()
Dim ws As Worksheet, LR As Integer
Application.ScreenUpdating = False
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Names"
For Each ws In ThisWorkbook.Worksheets
    With ws
        If .Name <> "Names" Then .Range("A6:A35").Copy Destination:=Sheets("Names").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End With
Next ws
With Worksheets("Names")
    .Rows(1).Delete
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A1:A" & LR).Sort Key1:=Range("A1"), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Try this

Code: 
Sub AppendData()
Dim ws As Worksheet, LR As Integer
Application.ScreenUpdating = False
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Names"
For Each ws In ThisWorkbook.Worksheets
    With ws
        If .Name <> "Names" Then .Range("A6:A35").Copy Destination:=Sheets("Names").Range("A" & Rows.Count).End(xlUp).Offset(1)
    End With
Next ws
With Worksheets("Names")
    On Error Resume Next
    .Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A1:A" & LR).Sort Key1:=Range("A1"), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Peter,

Is there a way to do the following from all the 26 sheets:

Extract the names from column A as above and extract the corresponding emails from column F, leaving behind the columns inbetween.

Inshort,
place the emails from column F, against the names in column A from all the 26 sheets in a new sheet 'NAMES' retaining all the functions of the last code.

Thanks
 
Upvote 0
Try this

Code: 
Sub AppendData()
Dim ws As Worksheet, LR As Integer
Application.ScreenUpdating = False
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Names"
For Each ws In ThisWorkbook.Worksheets
    With ws
        If .Name <> "Names" Then
            .Range("A6:A35").Copy Destination:=Sheets("Names").Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Range("F6:F35").Copy Destination:=Sheets("Names").Range("B" & Rows.Count).End(xlUp).Offset(1)
        End If
    End With
Next ws
With Worksheets("Names")
    On Error Resume Next
    .Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A1:B" & LR).Sort Key1:=Range("A1"), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

Z
  • Question Question
Vba - create new sheet and copy date into it.
Replies
1
Views
92
zerofeng
Z
G
  • Question Question
Extract Data
Replies
7
Views
139
Peter_SSs
Peter_SSs
T
  • Solved
Pull Data from Multiple Excel Files into a Summary Excel File to Create Graphs
2
Replies
11
Views
313
NdNoviceHlp
NdNoviceHlp
A
  • Solved
Pull data from multiple sheets based off name and month selected
Replies
2
Views
130
Amo840812
A
H
  • Question Question
Copy Data where Source Workbook contains Name that is in destination sheet
Replies
4
Views
151
howard
H

Forum statistics

Threads
1,224,525
Messages
6,179,319
Members
452,905
Latest member
deadwings

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top