View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
tommo_blade tommo_blade is offline
external usenet poster
 
Posts: 31
Default HELP= Problems Copying WorkBook Sheets

Hi,
I have started a new thread on this problem, my other thread got
a little lost and I was not getting the right answers. Basically I
need to copy sheets from 'n' different closed workbooks into my open
workbook from where the macro is being executed, this new sheet needs
to be the last sheet in my workbook, here is the copying code I am
using:

sourceBk.Worksheets(y).Copy _
After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)

The source file (closed workbooks) is ok, it reads this fine, what I
cannot work out is how to reference my open workbook, the code above
does not work, I have also tried using 'ActiveWorkbook' but it does
not like this either. the full code I am using is shown below.

Sub import_xls()
Dim y As Integer
Dim d As Integer
Dim p As Integer


Folder = "F:\My Documents\Fantasy Football\XLS_Emails\"
FName = Dir(Folder & "*.xls")
Application.ScreenUpdating = False
Do While FName < ""
d = 0
With ThisWorkbook
Set sourceBk = Workbooks.Open(Filename:=Folder & FName)
For y = 1 To sourceBk.Worksheets.Count
If Left(sourceBk.Worksheets(y).Cells(1, 1), 4) = "Name" Then
d = d + 1
MsgBox "FOUND A VALID TEAMSHEET " &
sourceBk.Worksheets(y).Cells(1, 2) & " IN:" & FName
For p = 8 To 18
If InStr(1, sourceBk.Worksheets(y).Cells(p, 2), 1) < "" Then
'MsgBox "PLAYER CELL POPULATED OK: " & p
Else
MsgBox "ERROR: EMPTY PLAYER CELL IN: " &
sourceBk.Workheets(y).Cells(p, 2)
Exit Sub
End If
Next p

Else
'MsgBox "UN-MATCHED TEAMSHEET:" & FName
End If

If d = 1 Then
MsgBox "CREATING NEW WORKSHEET FOR: " &
sourceBk.Worksheets(y).Cells(1, 2)

sourceBk.Worksheets(y).Copy _

After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)
sourceBk.Close savechanges:=False

End If
Next y
End With
Application.ScreenUpdating = True

FName = Dir()
Loop
End Sub