Transfering Data from worksheets by date

Good Evening all

I have a series of worksheets that are names all the same eg 2011 Data 2010 Data 2009 Data 2008, etc etc etc and are all identical in structure.

I use a macro to transfer the data from the eg 2011 Data across to the Winners worksheet, is there anyway that some code by placing the year ( eg 2008 ), in a cell in the Winners sheet, and the macro code transfer from from the respective DATA sheet into the winners sheet into the respective cells.

Attached is the Very much cutdown . XLSM file with some the macro's that I use.

PLEASE IGNORE the macro's as they are linked to sheets that have been removed, to leesen the file size


I ONLY NEED the data shaded in PINK to be transfered from Data named sheets to the winners sheet.

Regards

Peter

To best describe or illustrate your problem you would be better off attaching a dummy workbook, the workbook should contain the same structure and some dummy data of the same type as the type you have in your real workbook - so, if a cell contains numbers & letters in this format abc-123 then that should be reflected in the dummy workbook. Don't upload a picture when you have a workbook. None of us is inclined to recreate your data. Upload the workbook and manually add an 'after' situation so that we can see what you expect. In addition clearly explain how you get the results.

To attach a file to your post, you need to be using the main 'New Post' or 'New Thread' page and not 'Quick Reply'.
To use the main 'New Post' page, click the 'Post Reply' button in the relevant thread.

On this page, below the message box, you will find a button labelled 'Manage Attachments'.
Clicking this button will open a new window for uploading attachments.

You can upload an attachment either from your computer or from another URL by using the appropriate box on this page.
Alternatively you can click the Attachment Icon to open this page.

To upload a file from your computer, click the 'Browse' button and locate the file.

To upload a file from another URL, enter the full URL for the file in the second box on this page.
Once you have completed one of the boxes, click 'Upload'.

Once the upload is completed the file name will appear below the input boxes in this window.
You can then close the window to return to the new post screen.

Hi Potholes
if you enter the sheet name in I1 you can use some thing like..

Sub transfer_From_Sheet()
    Dim xSheet As Worksheet
    Dim eSheet As Worksheet
    With Worksheets("Winners")
        For Each eSheet In Worksheets
            If eSheet.Name = .Range("I1").Value Then
                With Worksheets(eSheet.Name)
                    .Range("H4:T100").Copy Destination:=Worksheets("Winners").Range("A4")
                MsgBox "Done"
                End With
            End If
        Next
    End With
End Sub

no problem. I'll have a closer look at you code as the are some enhancement that can be made

Hi poleholes

try..

Option Explicit
Sub transfer_From_Sheet()
    Dim xSheet As Worksheet
    Dim eSheet As Worksheet
    Dim xFound As Boolean
    Dim xRow As Long
    With Worksheets("Winners")
        For Each eSheet In Worksheets
            If eSheet.Name = .Range("I1").Value Then
               xFound = True
                With Worksheets(eSheet.Name)
                xRow = .Cells(Rows.Count, 1).End(xlUp).Row
                    .Range("H4:J" & xRow).Copy Destination:=Worksheets("Winners").Range("H4")
                    .Range("L4:M" & xRow).Copy Destination:=Worksheets("Winners").Range("E4")
                   .Range("L4:T" & xRow).Copy Destination:=Worksheets("Winners").Range("I4")
                MsgBox "Done"
                End With
            End If
        Next
        If Not xFound Then MsgBox " No worksheet Named " & .Range("I1").Value
    End With
 End Sub

Then....

Option Explicit
Sub transfer_From_Sheet()
    Dim xSheet As Worksheet
    Dim eSheet As Worksheet
    Dim xFound As Boolean
    Dim xRow As Long
    With Worksheets("Winners")
        For Each eSheet In Worksheets
            If eSheet.Name = .Range("I1").Value Then
               xFound = True
                With Worksheets(eSheet.Name)
                xRow = .Cells(Rows.Count, 1).End(xlUp).Row
                    Worksheets("Winners").Range("H4:J" & xRow).Value = .Range("H4:J" & xRow).Value
                    Worksheets("Winners").Range("E4:G" & xRow).Value = .Range("L4:M" & xRow).Value
                   Worksheets("Winners").Range("I4:Q" & xRow).Value = .Range("L4:T" & xRow).Value
                MsgBox "Done"
                End With
            End If
        Next
        If Not xFound Then MsgBox " No worksheet Named " & .Range("I1").Value
    End With
 End Sub

Good Morning

This is the Macro that I am using now, and it works.

Regards

Pete

Option Explicit
Sub Transfer_From_Sheet()
'
    Call Clear_Winners
'
    Dim xSheet As Worksheet
    Dim eSheet As Worksheet
    Dim xFound As Boolean
    Dim xRow As Long
    With Worksheets("Winners")
        For Each eSheet In Worksheets
            If eSheet.Name = .Range("G1").Value Then
               xFound = True
                With Worksheets(eSheet.Name)
                xRow = .Cells(Rows.Count, 1).End(xlUp).Row
                    Worksheets("Winners").Range("B4:F" & xRow).Value = .Range("H4:M" & xRow).Value
                    Worksheets("Winners").Range("G4:G" & xRow).Value = .Range("S4:S" & xRow).Value
'                   Worksheets("Winners").Range("I4:Q" & xRow).Value = .Range("L4:T" & xRow).Value
'                MsgBox "Done"
                End With
            End If
        Next
        If Not xFound Then MsgBox " No worksheet Named " & .Range("I1").Value
'
        Call Sort_Winners
'
        MsgBox "All Data Across"
'
    End With
 End Sub