View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Bob Phillips[_6_] Bob Phillips[_6_] is offline
external usenet poster
 
Posts: 11,272
Default Copying from closed files and IF statement

You need to declare the extra variables in your code

Dim sh2 As Worksheet
Dim iLastRow As Long

Add that and try this correction

Application.ScreenUpdating = False
Set sh2 = Worksheets("Sheet2")
iLastRow = sh2.Cells(sh2.Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow
sFileName = sh2.Cells(i, "A").Row
Set sh = ActiveWorkbook.Worksheets.Add
sh.Name = "Consol"
Set destrange = sh.Cells(1, 1)
'GetData sFileName, "Sheet1", "A1:D6", destrange, True
Select Case Consol!D2
Case 1: Application.Run "CopyToSh5"
Case 2: Application.Run "CopyToSh6"
Case 3: Application.Run "CopyToSh7"
'etc.
End Select
Next i



--

HTH

RP
(remove nothere from the email address if mailing direct)


"Robert" wrote in message
...
Thanks Bob for the fast response. I seem to have a problem.
When executing, I get a comple error "variable not defined" and
"sh2=" (your second line of code) is highlighted in blue. I have also
removed a coma after"CopyToSh6". I don't mind continuing to select
the files onscreen so long as the conditional posting to the respective
worksheets can be done.
--
Robert


"Bob Phillips" wrote:

You can loop through a list like so. I haven't tested this but it seems

to
be what you ask

Application.ScreenUpdating = False
Set sh2 = Worksheets("Sheet2")
iLastRow = sh2.Cells(sh2.Rows.Count,"A").End(xlUp).Row
For i = 1 To iLastRow
sFilename = sh2.Cells(i,"A").Row
Set sh = ActiveWorkbook.Worksheets.Add
sh.Name = "Consol"
Set destrange = sh.Cells(1, 1)
GetData sFilename, "Sheet1", "A1:D6", destrange, True
Select Case Consol!D2
Case1 : Application.Run "CopyToSh5"
Case 2: Application.Run "CopyToSh6",
Case 3: Application.Run "CopyToSh7"
'etc.
End Select
End If


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Robert" wrote in message
...
Though I do not know VBA I managed to adapt Ron de Bruins code as

follows.
It
does what I want thus far. I now wish to have an additional condition

i.e.IF
Consol!D2=1 Application.Run "CopyToSh5" , IF Consol!D2=2,

Application.Run
"CopyToSh6",IF Consol!D2=3,Application.Run "CopyToSh7", etc upto 10.

Any
help
from the ng will be appreciated.. Also would it be possible to select

the
files from a list (named range "SALES") in the Main Sheet rather than

an
onscreen selection

Sub GetData_Example3()
Dim SaveDriveDir As String, MyPath As String
Dim FName As Variant, N As Long
Dim destrange As Range
Dim sh As Worksheet
Application.Run "DeleteConsol"
SaveDriveDir = CurDir
MyPath = Application.DefaultFilePath 'or use "C:\Data"
ChDrive MyPath
ChDir MyPath
FName = Application.GetOpenFilename(filefilter:="Excel

Files,*.xls", _
MultiSelect:=True)
If IsArray(FName) Then
FName = Array_Sort(FName)

Application.ScreenUpdating = False
Set sh = ActiveWorkbook.Worksheets.Add
sh.Name = "Consol"
For N = LBound(FName) To UBound(FName)

Set destrange = sh.Cells(1, 1)
GetData FName(N), "Sheet1", "A1:D6", destrange, True
Application.Run "CopyToSh5"
Next
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
=============================
Sub CopyToSh5()
'
' Macro recorded 11/12/2005 by Robert
Sheets("Consol").Select
Range("A1:D6").Select
Selection.Copy
Sheets("Sheet5").Select

Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd,
SkipBlanks _
:=False, Transpose:=False
End Sub
================================================== =
Sub DeleteConsol()
' Macro recorded 11/12/2005 by Robert
Sheets("Consol").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet5").Select
Selection.Clear
End Sub

--
Robert