Command Button to import worksheets

[Mark Dullingham]

On a worksheet I have the following data

A
1 Name 1
2 Name 2
3 Name 3
etc up to 15

Within the same parent folder I have 15 single page workbooks named the same
as col a ie Name 1, Name 2 etc

I need to import copies of the single sheet workbooks as worksheets in my
main file in the order they appear in COL A

ie sheet1 then Name1, Name2, Name3 etc

So far i have managed to do this with 15 command buttons with the following
code;

Private Sub CommandButton2_Click()
Sheets("Front Sheet").Select
PathName = Range("JA26").Value
Filename = Range("G30").Value
If Filename = "" Then Exit Sub
TabName = Range("I30").Value
If I30 = ("Module 1") Then CommandButton2.Visible = True
ControlFile = ActiveWorkbook.Name
Workbooks.Open Filename:=PathName & Filename
ActiveSheet.Name = TabName
Sheets(TabName).Copy After:=Workbooks(ControlFile).Sheets(1)
Windows(Filename).Activate
ActiveWorkbook.Close SaveChanges:=False
Windows(ControlFile).Activate
Sheets("Front Sheet").Select

End Sub

I would like this to operate from 1 command button.

could some one point me in the right direction please.

Many thanks in advance.

Mark

 

[Dave Peterson]

Maybe something like:

Option Explicit
Private Sub CommandButton2_Click()
Dim FSWks As Worksheet
Dim TempWks As Worksheet
Dim TempWkbk As Workbook
Dim PathName As String
Dim FileName As String
Dim myRng As Range
Dim myCell As Range

Set FSWks = Worksheets("Front Sheet")

With FSWks
'the stuff in column A
Set myRng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))

PathName = .Range("JA26").Value
If Right(PathName, 1) <> "\" Then
PathName = PathName & "\"
End If

For Each myCell In myRng.Cells
'use column B as a report column
myCell.Offset(0, 1).Value = ""

'try to open the file (in readonly mode)
On Error Resume Next
Set TempWkbk = Workbooks.Open _
(FileName:=PathName & myCell.Value, ReadOnly:=True)
On Error GoTo 0

If TempWkbk Is Nothing Then
'couldn't be opened (bad name, wrong folder, password protected)
myCell.Offset(0, 1).Value = "Couldn't be opened!"
Else
Set TempWks = TempWkbk.Sheets(1)
TempWks.Copy _
after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
TempWkbk.Close savechanges:=False
End If
Next myCell
End With

End Sub