Taking columns from sheets

[Serdarrk]

Hello,

The following single file contains approximately 250 pages named by date. I need that opening new page in the file and take all pages' Y and Z columns starting from new page's D columns (I have to enter the names of the first three columns). I don't know it is possible but an other need when code copy and paste all Y and Z columns to new page, it must copy and paste name of every page to top of Y and Z columns (to 3.row). I hope I could tell. I will be very happy if you can help with this.


http://s7.dosya.tc/server3/9r93ou/01.02.2000-1.xls.html

 

[Serdarrk]

I have datas from 1999 to 2017 and I determined 24 names which are contunied for 19 years. So I need to list that include this 24 names' average price ( Y columns) and dates (name of sheets) to sort by rows in new sheet. As you said I need a macro code that when I change the name which in the code it will copy this name's price and date from every sheets and paste to new sheet's downward two colunms.

 

[mumps]

The easiest way to do this would be to add another sheet, Sayfa2, which would have all the names in column A starting at row 1. Could you upload a file which contains Sayfa2 with all the names?

 

[Serdarrk]

https://www.dropbox.com/s/44n7o341m1udrxm/list2.xls?dl=0

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim bottomA As Long
    bottomA = Sheets("Sayfa2").Range("A" & Rows.Count).End(xlUp).Row
    Dim ws As Worksheet
    Dim name As Range
    Dim foundName As Range
    For Each name In Sheets("Sayfa2").Range("A1:A" & bottomA)
        For Each ws In Sheets
            If Not ws.name Like "Sayfa*" Then
                Set foundName = ws.Range("B:B").Find(name, LookIn:=xlValues, lookat:=xlWhole)
                If Not foundName Is Nothing Then
                    Sheets("Sayfa1").Cells(Sheets("Sayfa2").Rows.Count, "A").End(xlUp).Offset(1, 0) = foundName
                    Sheets("Sayfa1").Cells(Sheets("Sayfa2").Rows.Count, "B").End(xlUp).Offset(1, 0) = ws.name
                    Sheets("Sayfa1").Cells(Sheets("Sayfa2").Rows.Count, "C").End(xlUp).Offset(1, 0) = ws.Range("Y" & foundName.Row)
                End If
            End If
        Next ws
    Next name
    Application.ScreenUpdating = True
End Sub

 

[Serdarrk]

I will try now and let you know

 

[Serdarrk]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim bottomA As Long
    bottomA = Sheets("Sayfa2").Range("A" & Rows.Count).End(xlUp).Row
    Dim ws As Worksheet
    Dim name As Range
    Dim foundName As Range
    For Each name In Sheets("Sayfa2").Range("A1:A" & bottomA)
        For Each ws In Sheets
            If Not ws.name Like "Sayfa*" Then
                Set foundName = ws.Range("B:B").Find(name, LookIn:=xlValues, lookat:=xlWhole)
                If Not foundName Is Nothing Then
                    Sheets("Sayfa1").Cells(Sheets("Sayfa2").Rows.Count, "A").End(xlUp).Offset(1, 0) = foundName
                    Sheets("Sayfa1").Cells(Sheets("Sayfa2").Rows.Count, "B").End(xlUp).Offset(1, 0) = ws.name
                    Sheets("Sayfa1").Cells(Sheets("Sayfa2").Rows.Count, "C").End(xlUp).Offset(1, 0) = ws.Range("Y" & foundName.Row)
                End If
            End If
        Next ws
    Next name
    Application.ScreenUpdating = True
End Sub

Sometimes I think you are creator of excel . I will write your name and profile link to sources of my dissertation. Thank you very much.

 

[mumps]

Thank you for the kind words and it was my pleasure.