Re: HELP=> Problems Copying WorkBook Sheets

Tech-Archive recommends: Speed Up your PC by fixing your registry

Set a reference to your workbook before you start and use that....

Dim wbMaster as Workbook
Set wbMaster = ActiveWorkbook

Use wbMaster as your reference

--

Regards,
Nigel
nigelnospam@xxxxxxxxx



"tommo_blade" <mark1.thompson45@xxxxxxxxxxxxxx> wrote in message news:e8f5895c-77c7-477f-8988-bb406ee0b9a1@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
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 *** needs
to be the last *** in my workbook, here is the copying code I am
using:

sourceBk.Worksheets(y).Copy _
After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.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 TEAM*** " &
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 TEAM***:" & FName
End If

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

sourceBk.Worksheets(y).Copy _

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

End If
Next y
End With
Application.ScreenUpdating = True

FName = Dir()
Loop
End Sub

.

Quantcast