need to copy 7th row of 50 different workbook

Microsoft Office excel 2007 home & stude...
August 5, 2010 at 10:26:47
Specs: Windows XP
There are 50 Excel workbooks containing similar data's in 7th row. Need a solution to copy 7th rows of all the 50 workbooks to single workbook.

For Eg

7.1st WB 0 1 2 0 4 1
7.2nd WB 1 0 1 2 0 0
7.3rd WB 0 2 1 0 4 0


Result shoud be

0 1 2 0 4 1
1 0 1 2 0 0
0 2 1 0 4 0


See More: need to copy 7th row of 50 different workbook

Report •


#1
August 5, 2010 at 12:36:12
re: There are 50 Excel workbooks containing similar data's in 7th row.

Strictly speaking, a workbook doesn't have "rows".

A workbook has sheets (1 or more) and those sheets have rows.

Do you mean the 7th row in a given sheet (Sheet1?) in 50 workbooks or do you mean the 7th row of 50 worksheets or some combination thereof?

P.S. It's customary to actually ask for assitance instead of just telling us what you need.



Report •

#2
August 5, 2010 at 22:45:41
Thanks, I meant 1st sheet of 50 workbooks has similar data in 7th Row

Report •

#3
August 7, 2010 at 06:46:24
Hi,

Here is a macro that will allow you to select Excel workbooks (xls & xlsx) - as many as you want, and it will open each in turn and copy Row 7 on Sheet1 in each workbook to Sheet1 in the summary workbook that contains this code.

The macro starts by asking the user if they want to keep existing data, or if they want to erase existing data and start over.

The data copied is Row 7 columns A to Z - you can change this in the following line:

    'set cells to copy as required
    wbThis.Worksheets("Sheet1").Range("A7:Z7").Copy _
            Destination:=rngFirstRow.Offset(intRowOffst, 0)

The macro then saves the updated summary workbook, but leaves it open.

To run the macro, I suggest you add a button to your summary worksheet.

From the Ribbon select Developer (If it's not visible go to the Office Button, select Excel options at the bottom and select the Popular tab and check the 'Show Developer tab in the Ribbon' box)

In Developer - Controls select Insert and choose the button icon.
Draw the button on the worksheet
In the 'Assign Macro' dialog box select 'New'

In the code window that opens enter this:

Option Explicit

Private Sub Button1_Click()
Dim varResp As Variant
Dim varFiles As Variant
Dim wsSmmry As Worksheet
Dim wbThis As Workbook
Dim intRowOffst As Integer
Dim rngFirstRow As Range
Dim n As Integer

On Error GoTo ErrHnd

'setup this worksheet
Set wsSmmry = ActiveSheet

'set Summary sheet row offset
intRowOffst = 0

'ask user if starting from new or adding to existing
varResp = MsgBox( _
        Prompt:="Do you want to erase existing data " _
        & "and start a new summary", _
        Buttons:=vbYesNoCancel + vbExclamation, _
        Title:="Start New or Add to Existing Data")
'test response
If varResp = vbCancel Then
    Exit Sub
    ElseIf varResp = vbNo Then
    'No, so find end of existing data in column A
    Set rngFirstRow = wsSmmry. _
            Range("A" & CStr(Application.Rows.Count)) _
            .End(xlUp).Offset(1, 0)
    Else
    'Yes to clear worksheet and start at A2
    wsSmmry.Cells.Clear
    Set rngFirstRow = wsSmmry.Range("A2")
End If

'open the 'File Open' dialog box to select xls and xlsx files
varFiles = Application.GetOpenFilename( _
            FileFilter:="Excel Files(*.xls;*.xlsx),*.xls;*.xlsx", _
            MultiSelect:=True, _
            Title:="Select Excel files for Row 7 summary")
'test for Cancel - Multi select always returns an array
'even for 1 file selected - but Cancel returns 'False'
If Not IsArray(varFiles) Then
    Exit Sub
End If

'turn off screen updating
Application.ScreenUpdating = False
'supress messages
Application.DisplayAlerts = False

'loop through all files selected
For n = 1 To UBound(varFiles, 1)
    'open each file
    Set wbThis = Application.Workbooks.Open(varFiles(n))
    'get part of row 7 from Sheet1 - don't copy whole row as
    'number of columns varies between versions
    'set cells to copy as required
    wbThis.Worksheets("Sheet1").Range("A7:Z7").Copy _
            Destination:=rngFirstRow.Offset(intRowOffst, 0)
    'increment row offset
    intRowOffst = intRowOffst + 1
    'close workbook without saving
    wbThis.Close SaveChanges:=False
Next n

'turn on screen updating
Application.ScreenUpdating = True
'allow messages
Application.DisplayAlerts = True

'save the summary workbook
wsSmmry.Parent.Save
Exit Sub

'error handler
ErrHnd:
Err.Clear
'turn on screen updating
Application.ScreenUpdating = True
'allow messages
Application.DisplayAlerts = True
End Sub

Note that Sub Button1_Click() and End sub will already be present, so don't duplicate them. Option explicit goes before Sub Button1_Click().

Click Save from the Visual Basic Menu.

Alt+f11 takes you back to the main Excel window.

Right click the button and Edit the name to something meaningful

As changes made by Macros cannot be undone with the Undo button, test this macro on a copy of your data. Always make a backup of your Workbook before running this macro. This code has only been tested on sample data, and it has not been tested in your environment, so test it on copies of your data to ensure that it works 'as expected'

After selecting any cell, the new command button should now respond to a click and run the macro.

Regards


Report •

Related Solutions

#4
August 7, 2010 at 10:16:20
Thanks !!!! thanks a lot.... it works well and good... It saves more time.... once again Thank you

Report •

#5
August 7, 2010 at 10:48:39
Hi,

You're welcome.

Thanks for the feedback

Regards

Humar


Report •

Ask Question