Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Macro to Open 52 Individual Workbooks 1

Status
Not open for further replies.

Topcat04

Technical User
Sep 14, 2007
121
GB
Hi
I was previously posting in Microsoft Office, but it would seem that this forum is more appropriate for my requirements.
Im looking to open up 52 individual workbooks and copy out the data that is in Column N and put it into a master sheet against each of the appropriate sku numbers from Column A, week by week.
Im unable to just copy the data from column N as the Sku numbers in Column A are not always in the same order.

I have run a simple Macro to extract the sku numbers and Data from one of the workbooks and pasted into the new master workbook (Book1)

Sub OpenGMWkBk()
'
' OpenGMWkBk Macro
'
' Keyboard Shortcut: Ctrl+Shift+Q
'
Workbooks.Open Filename:= _
"D:\Dropbox\GMB UK\Sales Analysis\GM\Weekly Files\GMWK52.xls"
Range("A13:A106").Select
ActiveWindow.ScrollRow = 78
ActiveWindow.ScrollRow = 77
ActiveWindow.ScrollRow = 76
ActiveWindow.ScrollRow = 73
ActiveWindow.ScrollRow = 72
ActiveWindow.ScrollRow = 71
ActiveWindow.ScrollRow = 68
ActiveWindow.ScrollRow = 66
ActiveWindow.ScrollRow = 65
ActiveWindow.ScrollRow = 62
ActiveWindow.ScrollRow = 61
ActiveWindow.ScrollRow = 59
ActiveWindow.ScrollRow = 58
ActiveWindow.ScrollRow = 56
ActiveWindow.ScrollRow = 55
ActiveWindow.ScrollRow = 54
ActiveWindow.ScrollRow = 49
ActiveWindow.ScrollRow = 47
ActiveWindow.ScrollRow = 45
ActiveWindow.ScrollRow = 43
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 33
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 25
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Range("A13:A106,N13:N106").Select
Range("N13").Activate
Selection.Copy
Windows("Book1").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Windows("GMWK52.xls").Activate
ActiveWindow.Close
Range("A1").Select
End Sub

Look forward to your support,
Thanks
TC
 
Hi,

Thanks for recording this macro and posting here in this forum.

I thought that you were going to copy all the data in your table, the data in column A thru N, into this consolidated table for all 52 workbooks. Then after this macro (open 52 files, copy n paste) you'll end up with one table with 15 columns, A thru O, since we're adding an additional column to identify the week, unless you changed your mind.

In addition to this clarification, please verify that the headings are in row 13 in all 52 Workcooks.

Also is there any data in row 12 or is there any data in column O?

 
Hi Skip
The Data between, B and M is not relevant data, however please find the new code below.
Sub OpenGMWkBk()
'
' OpenGMWkBk Macro
'
' Keyboard Shortcut: Ctrl+Shift+Q
'
Workbooks.Open Filename:= _
"D:\Dropbox\GMB UK\Sales Analysis\GM\Weekly Files\GMWK52.xls"
Range("A13:N106").Select
ActiveWindow.ScrollRow = 79
ActiveWindow.ScrollRow = 78
ActiveWindow.ScrollRow = 77
ActiveWindow.ScrollRow = 76
ActiveWindow.ScrollRow = 75
ActiveWindow.ScrollRow = 73
ActiveWindow.ScrollRow = 71
ActiveWindow.ScrollRow = 69
ActiveWindow.ScrollRow = 68
ActiveWindow.ScrollRow = 67
ActiveWindow.ScrollRow = 65
ActiveWindow.ScrollRow = 64
ActiveWindow.ScrollRow = 62
ActiveWindow.ScrollRow = 60
ActiveWindow.ScrollRow = 59
ActiveWindow.ScrollRow = 56
ActiveWindow.ScrollRow = 55
ActiveWindow.ScrollRow = 53
ActiveWindow.ScrollRow = 52
ActiveWindow.ScrollRow = 51
ActiveWindow.ScrollRow = 50
ActiveWindow.ScrollRow = 49
ActiveWindow.ScrollRow = 48
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 44
ActiveWindow.ScrollRow = 43
ActiveWindow.ScrollRow = 42
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 38
ActiveWindow.ScrollRow = 37
ActiveWindow.ScrollRow = 36
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 25
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
Selection.Copy
Windows("WeeklyTest.xlsm").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Windows("GMWK52.xls").Activate
ActiveWorkbook.Close
End Sub


The headings are in row 13 in all workbooks
Row 12 is actually empty, however there is Textual information in Rows 5-11, with cells that are merged - but it just contains text about what week it is and the group of data in the report below and not relevant.

Please let me know if this macro coding is better.
Thanks
TC
 
I suppose that if B:M will never ever be relevant useful data in any context, then we'll just get A & N

See how this works.
Code:
Option Explicit

Sub OpenGMWkBk()
'
' OpenGMWkBk Macro
'
' Keyboard Shortcut: Ctrl+Shift+Q
'
    Dim lRow As Long, wbMaster As Workbook, iWB As Integer, i As Integer, lLastRow As Long
    
    Set wbMaster = Workbooks("WeeklyTest.xlsm")
    
    With wbMaster
        With .Sheets(1)
    'enter headings in master
            .Cells(1, 1).Value = "SKU"
            .Cells(1, 2).Value = "Sales"
            .Cells(1, 3).Value = "Week"
        End With
        .Save
    End With
    
    For iWB = 1 To 52
    'get next row in master
        lRow = wbMaster.Sheets(1).UsedRange.Rows.Count + 1
    'open source workbook
        With Workbooks.Open(Filename:="D:\Dropbox\GMB UK\Sales Analysis\GM\Weekly Files\GMWK" & Format(iWB, "00") & ".xls")
            With .Sheets(1)
                For i = 1 To 2
                    Select Case i
    'copy source data to master
                        Case 1
                            .Range(.Cells(14, "A"), .Cells(106, "A")).Copy wbMaster.Sheets(1).Cells(lRow, "A")
                        Case 2
                            .Range(.Cells(14, "N"), .Cells(106, "N")).Copy wbMaster.Sheets(1).Cells(lRow, "B")
                    End Select
                Next
            End With
            .Close
        End With
            
        With wbMaster.Sheets(1)
    'get last row in master
            lLastRow = .UsedRange.Rows.Count
    'fill the week in this segment
            .Range(.Cells(lRow, "C"), .Cells(lLastRow, "C")).Value = "2014-" & Format(iWB, "00")
        End With
    Next
End Sub
 
Skip
That's Brill!!
Thank you so much for all the time and effort you have put in and the time you have saved me...
Very much appreciated!
TC
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top