VBA Macro to open excel workbook and copy and paste

[rcpalmer]

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!

 

[Domenic]

Make sure that the workbook containing the tabs for each individual is the active workbook, then try...

[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]