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
|