VBA Macro to open excel workbook and copy and paste

rcpalmer

New Member
Joined
Apr 25, 2003
Messages
28
I have a workbook with a bunch of tabs with different names.
*
Each tab name is the same as the name of an Excel file on my hard drive.
*
Example
*
Tab = Frank
*
File on hard drive = Frank.xls
*
I am not very good working on macros (i need to take a course).
I would like a macro that looks at the tab name (Frank),
opens that excel file (Frank.xls),
copys infomation from Frank.xls, sheet 2, cells a12 - aXX (each file will have a different length of items in column a),
and pastes them on Tab Frank A1 - AXXX
*
It would then move to the next tab (Johnny) and do the same thing over and over until all tabs have had the info from the file copied.
*
Please help if you can!!
*
You guys rock!
 

Some videos you may like

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,294
Make sure that the workbook containing the tabs for each individual is the active workbook, then try...

Code:
[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] test()

    [color=green]'Declare the variables[/color]
    [color=darkblue]Dim[/color] strPath [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strFile [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] wkbDest [color=darkblue]As[/color] Workbook
    [color=darkblue]Dim[/color] wkbSource [color=darkblue]As[/color] Workbook
    [color=darkblue]Dim[/color] wksSource [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] wks [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] CopyRng [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=green]'Turn off screen updating[/color]
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    [color=green]'Define the path to the folder containing the target files and assign it to a variable (change accordingly)[/color]
    strPath = "C:\Users\Domenic\Desktop\Test\"
    
    [color=green]'Make sure that the path ends in a back slash[/color]
    [color=darkblue]If[/color] Right(strPath, 1) <> "\" [color=darkblue]Then[/color] strPath = strPath & "\"
    
    [color=green]'Assign the active workbook to an object variable[/color]
    [color=darkblue]Set[/color] wkbDest = ActiveWorkbook
    
    [color=green]'Loop through each worksheet in the active workbook[/color]
    [color=darkblue]For[/color] [color=darkblue]Each[/color] wks [color=darkblue]In[/color] wkbDest.Worksheets
        [color=green]'Check if a file named after the current worksheet exists[/color]
        [color=darkblue]If[/color] Dir(strPath & wks.Name & ".xls") <> "" [color=darkblue]Then[/color]
            [color=green]'Open the file named after the current worksheet and assign it to an object variable[/color]
            [color=darkblue]Set[/color] wkbSource = Workbooks.Open(strPath & wks.Name & ".xls")
            [color=green]'Assign Sheet2 of the opened file to an object variable[/color]
            [color=darkblue]Set[/color] wksSource = wkbSource.Worksheets("Sheet2")
            [color=darkblue]With[/color] wksSource
                [color=green]'Find the last used row in Column A of Sheet2[/color]
                LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
                [color=green]'Check if data exists[/color]
                [color=darkblue]If[/color] LastRow >= 12 [color=darkblue]Then[/color]
                    [color=green]'Clear the contents of Column A of the current worksheet for copy/paste[/color]
                    wks.Columns("A").ClearContents
                    [color=green]'Define the copy range for Sheet2 and assign it to an object variable[/color]
                    [color=darkblue]Set[/color] CopyRng = .Range("A12:A" & LastRow)
                    [color=green]'Copy/paste the data to A1 of the current worksheet[/color]
                    CopyRng.Copy Destination:=wks.Range("A1")
                [color=darkblue]End[/color] [color=darkblue]If[/color]
            [color=darkblue]End[/color] [color=darkblue]With[/color]
            [color=green]'Close the opened file without saving it[/color]
            wkbSource.Close savechanges:=[color=darkblue]False[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] wks
    
    [color=green]'Turn on screen updating[/color]
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
    [color=green]'Display a message indicating that the procedure has been completed[/color]
    MsgBox "Completed...", vbInformation
            
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]
 

Watch MrExcel Video

Forum statistics

Threads
1,108,492
Messages
5,523,260
Members
409,506
Latest member
reneekeane

This Week's Hot Topics

Top