View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
Rick Rothstein \(MVP - VB\)[_2234_] Rick Rothstein \(MVP - VB\)[_2234_] is offline
external usenet poster
 
Posts: 1
Default HELP= Problems Copying WorkBook Sheets

MsgBox "TEAMSHEET: " & wksSource
MsgBox "CREATING NEW WORKSHEET FOR: " &
wksSource & "#" & wksSource.Cells(1, 2)


I am pretty sure that for the above two MessageBox statements, the problem
is with your trying to concatenate wksSource (an object) as if it were a
String value. I that these two statements should work correctly if you use
wksSource.Name instead of wksSource by itself. On the other hand, and I may
be missing something obvious here, but I don't see anything immediate wrong
with this statement...

wksSource.Copy After:=ThisWorkbook.Worksheets(
ThisWorkbook.Worksheets.Count)


Let's take this in steps. Correct the first two problems listed above and
run your code.... does it still have problems elsewhere, or is this Copy now
the only problem?

Rick


"tommo_blade" wrote in message
...
I have implemented all of your suggestions but there is still a
problem, the code does not like the 'wksSource' statement, even when I
try and print it directly after the 'for each wksSource' line, it does
not give an error - it simply stops the program running, opens the VB
editor and highlights the problem lines in yellow, see below:


Sub import_xls()
Dim y As Integer
Dim d As Integer
Dim p As Integer
Dim c As Integer
Dim wksSource As Worksheet

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 Each wksSource In sourceBk.Worksheets
MsgBox "TEAMSHEET: " & wksSource <---------------------------
DOES NOT LIKE THE 'wksSource'
If Left(wksSource.Cells(1, 1), 4) = "Name" Then
d = d + 1
MsgBox "FOUND A TEAMSHEET " & wksSource.Cells(1, 2) & " IN: "
& FName
For p = 8 To 18
If InStr(1, wksSource.Cells(p, 2), 1) < "" Then
'MsgBox "PLAYER CELL POPULATED OK: " & p
Else
MsgBox "ERROR: EMPTY PLAYER CELL IN: " &
wksSource.Cells(p, 2)
Exit Sub
End If
Next p

Else
MsgBox "UN-MATCHED TEAMSHEET:" & wksSource
End If

If d = 1 Then
MsgBox "CREATING NEW WORKSHEET FOR: " & wksSource & "#" &
wksSource.Cells(1, 2) <--------------------------- DOES NOT LIKE
THE 'wksSource'
wksSource.Copy
After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksh eets.Count)
<--------------------------- DOES NOT LIKE THE 'wksSource'
sourceBk.Close savechanges:=True
ElseIf d 1 Then
MsgBox "WORKBOOK CONTAINS TOO MANY SHEETS: "
End If
Next wksSource
End With
Application.ScreenUpdating = True

FName = Dir()
Loop
End Sub