Copying from closed files and IF statement

[Robert]

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", "A16", 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("A16").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

 

[Bob Phillips]

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", "A16", 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]

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.

 

[Bob Phillips]

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", "A16", 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]

Using new code as below. Error "i" (marked**) "not declared".
When "Dim i As Long" (????) was added, sFileName (next row)
became "not declared". Thank you for your patience, perhaps
one more try?.Please check if my ending is correct.
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
Dim sh2 As Worksheet
Dim iLastRow As Long

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 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", "A16", 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
End Sub

 

[Bob Phillips]

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
Dim sh2 As Worksheet
Dim iLastRow As Long
Dim i As Long
Dim sFilename As String
Application.Run "DeleteConsol"
SaveDriveDir = CurDir
MyPath = Application.DefaultFilePath 'or use "C:\Data"
ChDrive MyPath
ChDir MyPath
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", "A16", destrange, True
Select Case Worksheets("Consol").Range("D2")
Case 1: Application.Run "CopyToSh5"
Case 2: Application.Run "CopyToSh6"
Case 3: Application.Run "CopyToSh7"
'etc.
End Select
Next i
End Sub


--

HTH

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

 

[Robert]

Dear Bob after trying many many times with with possible solutions,
have to call it a day. The code still does not work. Could it
be that the original code was meant to read from closed files.
Actions that took place. Sheet "Consol" was deleted, then window
msg "The file name, Sheet or Range is invalid of:1", then runtime
error 1004. "sh.name="Consol" highlighted in yellow. A new worksheet
gets inserted at each run with the sheet numbers incrementing by 2.
Thank you for your efforts. I shall monitor for responses failing which I
shall use the original code.

Robert

 

[Bob Phillips]

Robert,

The difficulty lies in the code referring to other procedures which you have
but we do not. One certainly seems to delete the Consol worksheet (judging
by its name), but that does not explain why the sh.Name should fail.

Perhaps if you share DeleteConsol, GetData, CopyToSh5, CopyToSh6
andCopyToSh7 macros with us we might be able to test it.

--

HTH

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

 

[Robert]

Thanks again Bob for the follow up. I don’t have a GetData Sub.
The other codes as given below. For testing purposes I had 3 files,
Test2.xls, Test3.xls, Test4.xls with just some numbers A26,
D2 having 1 to 5 only. The main file had sheets 1, Consol, 5,6,7

What I am attempting is to copy Range A16 from a range of closed files one
At a time to Consol!A2. Check for value of D2. If “1†copy the contents to
Sheet5,
PasteSpecial Add, If “2†to Sheet6,PasteSpecial Add, If “3†to Sheet7 and
so on.
The paste range of all destination sheets will have to be cleared of
historic values
at the start of the process. As such Consol need not be deleted and and a new
Worksheet entered and renamed. The existing code does that because I adapted
(through hours of trial and error) Ron de Bruins to copy data from closed
files. His original code copys the data from the closed files (which is a
VERY BIG HELP) sequentially downwards in a sheet which I named “Consolâ€. My
desire is to sum the
values copied according to different data type, hence the checking in D2. I
could use
the Paste Link, but I have over 70 source files.

Sub CopyToSh5()
'
' CopyToSh5 Macro
' Macro recorded 11/12/2005 by Robert
'

'
Sheets("Consol").Select
Range("A16").Select
Selection.Copy
Sheets("Sheet5").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd,
SkipBlanks _
:=False, Transpose:=False
End Sub
Sub CopyToSh6()
'
' CopyToSh6 Macro
' Macro recorded 11/14/2005 by Robert
'
Sheets("Consol").Select
Range("A16").Select
Selection.Copy
Sheets("Sheet6").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd,
SkipBlanks _
:=False, Transpose:=False

End Sub
Sub CopyToSh7()
'
' CopyToSh7 Macro
' Macro recorded 11/14/2005 by Robert
'
Sheets("Consol").Select
Range("A16").Select
Selection.Copy
Sheets("Sheet7").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd,
SkipBlanks _
:=False, Transpose:=False

End Sub
Sub DeleteConsol()
'
' DeleteConsol Macro
' Macro recorded 11/12/2005 by Robert '

'
Sheets("Consol").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet5").Select
Range("A17").Select
Selection.Clear

Sheets("Sheet6").Select
Range("A17").Select
Selection.Clear

Sheets("Sheet7").Select
Range("A17").Select
Selection.Clear

Sheets("Sheet2").Select
End Sub
========================================
Regards