Copy from open excel sheet and paste into close excel sheet

Hi:

I have attached excel files for referance

I need certain data from (Source File ) 10_2010_Store#1_DailySales to be copied into files
This is Open excel file and VB script can be in this sheet:

Destination Files - closed excel file ( i have all 31 blankfiles)
10-1-10_Store#1_REG1
10-2-10_Store#1_REG1
10-3-10_Store#1_REG1
10-4-10_Store#1_REG1 and so on until

10-31-10_Store#1_REG1.

Data need to be imported from 10_2010_Store1_DailySales


P119:Q178 into 10-1-10_Store#1_REG1 at A2:B61
T119:U178 into 10-2-10_Store#1_REG1 at A2:B61
X119:Y178 into 10-3-10_Store#1_REG1 at A2:B61

and so..(FYI : every 3rd Column data)

Let us try just for 2 files for now and then we can implement for full month.

FYI : I need to restore my daily receipt since the server they were in had crashed and i have lost daily receipts.

Please let me know if you have any questions.

Help is greatly appreciated..

Thanks...
RM

You can't copy to a closed workbook.

There's no indication how the daily sheets relate to the master

Try this,
Unzip all the workbooks and save into one separate folder, after you have adjusted the code in Module2 to the proper path,
click the button in the store sales sheet,

Hi RM,

You are copying to A2, not A2: B61

Bolded text shows the additional code

Sub Button1_Click()


    Dim r As Range, c As Range, cl As Range, wb1 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet, x As Integer
    Dim Str1 As String, Str2 As String

    Set wb1 = Workbooks("10_2010_Store#1_DailySalesX")
    Set ws2 = wb1.Worksheets("Daily_Receipt")

        Str1 = "REG_CNTR"
        Str2 = "REG_TOTAL"

    Application.ScreenUpdating = False

    Sheets.Add().Name = "List"

    Set ws1 = Worksheets("List")



    myFile = Dir(ActiveWorkbook.Path & "\*.xls")
    i = 1
    Do While myFile <> ""
        If myFile <> ActiveWorkbook.Name Then
            Cells(i, 1) = myFile
            i = i + 1
        End If
        myFile = Dir
    Loop

    Set r = ws1.Range("A1", ws1.Range("A65536").End(xlUp))
    Set rng = ws2.Range("A1")

    x = 16
    For Each c In r.Cells



        Workbooks.Open Filename:="E:\WorkBookLoop\" & c    '***************CHANGE THIS

        Range(ws2.Cells(119, x), ws2.Cells(178, x + 1)).Copy Destination:=ActiveWorkbook.Worksheets("Sheet1").Range("A2")
        ActiveWorkbook.Worksheets("Sheet1").Range("A1") = Str1
        ActiveWorkbook.Worksheets("Sheet1").Range("B1") = Str2

        ActiveWorkbook.Close Save = False
        x = x + 4
    Next c

    With Application
        .DisplayAlerts = False
        Sheets("List").Delete
        .DisplayAlerts = True

    End With

    MsgBox "Done !!"

End Sub

I suppose some more manipulation is required, this is why I went with the helper sheet in the first place, I forgot to add the sort part though

Sub Button1_Click()


    Dim r As Range, c As Range, cl As Range, wb1 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet, x As Integer
    Dim Str1 As String, Str2 As String
    Dim rw As Long

    Set wb1 = Workbooks("10_2010_Store#1_DailySalesX")
    Set ws2 = wb1.Worksheets("Daily_Receipt")

    Str1 = "REG_CNTR"
    Str2 = "REG_TOTAL"

    Application.ScreenUpdating = False

    Sheets.Add().Name = "List"

    Set ws1 = Worksheets("List")



    myFile = Dir(ActiveWorkbook.Path & "\*.xls")
    i = 1
    Do While myFile <> ""
        If myFile <> ActiveWorkbook.Name Then
            Cells(i, 2) = myFile'this is the bolded code
            i = i + 1
        End If
        myFile = Dir
    Loop

    rw = ActiveSheet.UsedRange.Rows.Count


    ws1.Columns("B:B").TextToColumns Destination:=Range("B1"), Other:=True, OtherChar:="-"
    ws1.Columns("B:D").Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
                            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                            DataOption1:=xlSortNormal


    Range("A1:A" & rw) = "=RC[1]&""-""&RC[2]&""-""&RC[3]"


    Set r = ws1.Range("A1", ws1.Range("A65536").End(xlUp))
    Set rng = ws2.Range("A1")

    x = 16
    For Each c In r.Cells



        Workbooks.Open Filename:="E:\WorkBookLoop\" & c    '***************CHANGE THIS

        Range(ws2.Cells(119, x), ws2.Cells(178, x + 1)).Copy Destination:=ActiveWorkbook.Worksheets("Sheet1").Range("A2")
        ActiveWorkbook.Worksheets("Sheet1").Range("A1") = Str1
        ActiveWorkbook.Worksheets("Sheet1").Range("B1") = Str2

        ActiveWorkbook.Close Save = False
        x = x + 4
    Next c

    With Application
        .DisplayAlerts = False
        Sheets("List").Delete
        .DisplayAlerts = True

    End With

    MsgBox "Done !!"

End Sub

Hi Dave :

FYI:
List sheet has following file names in order:
10-1-10_Store#1_Z1_REG1.xls
10-10-10_Store#1_Z1_REG1.xls
10-11-10_Store#1_Z1_REG1.xls
10-12-10_Store#1_Z1_REG1.xls
10-13-10_Store#1_Z1_REG1.xls
10-2-10_Store#1_Z1_REG1.xls
10-3-10_Store#1_Z1_REG1.xls
10-4-10_Store#1_Z1_REG1.xls
10-5-10_Store#1_Z1_REG1.xls
10-6-10_Store#1_Z1_REG1.xls
10-7-10_Store#1_Z1_REG1.xls
10-8-10_Store#1_Z1_REG1.xls
10-9-10_Store#1_Z1_REG1.xls

RM

Check it again, in post #11