End(xlDown) Error 1

[JimLes]

Hello,

I have the following code which works perfectly when I used the named range called "Rng" but when I try to use End(xlDown) from A2, I get an error. Is there any way to modify the code to do this?

Thanks!!!


Sub ImportSheets()
Dim Path As String
Dim filename As String
Dim sht As Worksheet
Dim wkB As Workbook
Dim i As Integer
Dim r As Range
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
'Set the file path
Path = "R:\HR Ops Team Folders\Reporting & Analysis\Headcount\HC Data"
filename = Dir(Path & "\*.xls")
i = 1
Do While filename <> ""
'set filenames in worksheet "wsTabNames" in A column to tab name in B column
Set r = Worksheets("wsTabNames").Range("A2").End(xlDown) 'this selects all files names in named range "Rng" in sheet "wsTabnames"
For Each r In Worksheets("wsTabNames").Range("A2").End(xlDown) 'Range("Rng")
If r.Value = filename Then
Set sht = ThisWorkbook.Sheets(r.Offset(0, 1).Value) 'this assigns filename to tab name in sheet "wsTabNames"
Exit For
End If
Next
'Next import the first worksheet for each file under R:\HC Data
Set wbK = Workbooks.Open(filename:=Path & "\" & filename)
If SheetExists("Sheet1") Then
Set wkB = ActiveWorkbook
wbK.Sheets("Sheet1").Cells.Copy 'this copies data to assigned r value tab name
sht.[A1].PasteSpecial xlPasteValues
ActiveSheet.Name = "Sheet" & i
i = i + 1
wkB.Close savechanges:=False
Else
MsgBox "Sheets1 does not exist in file '" & filename & "'", vbExclamation, "ERROR !!"
ActiveWorkbook.Close savechanges:=False
End If
filename = Dir
Loop

Sheets("Forecast Data").Select
MsgBox "All files have been imported successfully!"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Bong]

I don't think you want to use set. That is:

r = Worksheets("wsTabNames").Range("A2").End(xlDown)

without the "set"

_________________
Bob Rashkin

 

[JimLes]

I took off the "Set" and ran the code again but got an error on that line.

r = Worksheets("wsTabNames").Range("A2").End(xlDown)

The watch said "no cells were found"

Thanks,

 

[JimLes]

Bob, thanks for you help. You got me on the right track.

I tweaked the code and this seems to work okay:

Set sh1 = Sheets("wsTabNames")
Set r = sh1.Range(sh1.Range("A2"), sh1.Range("A2").End(xlDown)) 'this selects all files names in Column A in sheet "wsTabnames"
For Each r In sh1.Range(sh1.Range("A2"), sh1.Range("A2").End(xlDown))
If r.Value = filename Then
Set sht = ThisWorkbook.Sheets(r.Offset(0, 1).Value) 'this assigns filename to tab name in sheet "wsTabNames"
Exit For
End If
Next


Jim

 

[SkipVought]

  Dim r as range, rng as range
  Set rng = sh1.Range(sh1.Range("A2"), sh1.Range("A2").End(xlDown)) 'this selects all files names in Column A in sheet "wsTabnames"
  For Each r In rng

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}