Subscript out of range error in this Excel VBA script

I would like to copy data from a CSV file into an Excel worksheet. There are 11 .csv files. So far I have this (it is a modified version from a previous post):

Sub importData()   
  Dim filenum(0 To 10) As Long
  filenum(0) = 052
  filenum(1) = 060
  filenum(2) = 064
  filenum(3) = 068
  filenum(4) = 070
  filenum(5) = 072
  filenum(6) = 074
  filenum(7) = 076
  filenum(8) = 178
  filenum(9) = 180
  filenum(10) = 182

  Dim sh1 As Worksheet
  On Error GoTo my_handler

  For lngPosition = LBound(filenum) To UBound(filenum)
    'Windows(filenum(lngPosition) & ".csv").Activate
    Workbooks.Add(filenum(lngPosition) & ".csv").Activate
Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    Windows("30_graphs_w_Macro.xlsm").Activate
    Set sh1 = Worksheets(filenum(lngPosition)).Activate
    Range("A69").Paste
    Range("A69").Select

  Next lngPositionlngPositionlngPosition

my_handler:
  MsgBox "All done."
  Exit Sub
End Sub

This code gives me a subscript out of range error on the line:

Set sh1 = Worksheets(filenum(lngPosition)).Activate

Siddharth Rout

Set sh1 = Worksheets(filenum(lngPosition)).Activate

You are getting Subscript out of range error error becuase it cannot find that Worksheet.

Also please... please... please do not use .Select/.Activate/Selection/ActiveCell You might want to see How to Avoid using Select in Excel VBA Macros.

This looks a little better than your previous version but get rid of that .Activate on that line and see if you still get that error.

Dim sh1 As Worksheet
set sh1 = Workbooks.Add(filenum(lngPosition) & ".csv")

Creates a worksheet object. Not until you create that object do you want to start working with it. Once you have that object you can do the following:

sh1.Range("A69").Paste
sh1.Range("A69").Select

The sh1. explicitely tells Excel which object you are saying to work with... otherwise if you start selecting other worksheets while this code is running you could wind up pasting data to the wrong place.

Venkata Gowda

Private Sub CommandButton1_Click()

    Dim Data As Object, Employee As Object

    Application.ScreenUpdating = False

    Set Data = ThisWorkbook.Sheets("Data")

    Set Employee = ThisWorkbook.Sheets("Employee Names")

    Data.Range("AK1").Value = "Lookup"

    Data.Range("AK2:AK" & Data.Range("A1").End(xlDown).Row).Formula = "=VLOOKUP(E2,'Employee Names'!$A:$A,1,0)"

    Data.Range("AK2:AK" & Data.Range("A1").End(xlDown).Row).Value = Data.Range("AK2:AK" & Data.Range("A1").End(xlDown).Row).Value

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=5, Criteria1:="<>"

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=37, Criteria1:="#N/A"

    Application.DisplayAlerts = False

    Data.AutoFilter.Range.Offset(1, 0).Rows.SpecialCells(xlCellTypeVisible).Delete (xlShiftUp)

    Data.Range("AK:AK").Delete

    Data.AutoFilterMode = False

    'Selection.AutoFilter

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=7, Criteria1:="="

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=12, Criteria1:="<>"

    Worksheets("Data").Range("A1:AK" & Data.Range("A1").End(xlDown).Row).Copy

    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "DrfeeRequested"

    Set Dr = ThisWorkbook.Worksheets("DrfeeRequested")

    Dr.Range("A1").PasteSpecial Paste:=xlPasteValues

    Application.CutCopyMode = False

    Data.AutoFilterMode = False

    'DrfeeRequested.AutoFilterMode = False

    Selection.AutoFilter

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=13, Criteria1:="<>"

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).Copy

    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "RateLockfollowup"
    Set Ratefolup = ThisWorkbook.Worksheets("RateLockfollowup")

    Ratefolup.Range("A1").PasteSpecial Paste:=xlPasteValues

    Application.CutCopyMode = False

    Data.AutoFilterMode = False

    Selection.AutoFilter

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=19, Criteria1:="="

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=13, Criteria1:="<>"

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).Copy

    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Lockedlefollowup"
    Set Lockfolup = ThisWorkbook.Worksheets("Lockedlefollowup")

    Lockfolup.Range("A1").PasteSpecial Paste:=xlPasteValues

    Application.CutCopyMode = False

    Data.AutoFilterMode = False

    Selection.AutoFilter

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=19, Criteria1:="="

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).Copy

    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Hoifollowup"

    Set Hoifolup = ThisWorkbook.Worksheets("Hoifollowup")

    Hoifolup.Range("A1").PasteSpecial Paste:=xlPasteValues

    Application.CutCopyMode = False

    Data.AutoFilterMode = False

    Selection.AutoFilter

    TodayDT = Format(Now())

    Weekdy = Weekday(Now())

    If Weekdy = 2 Then
       LastTwoDays = Now() - Weekday(Now(), 3)
    ElseIf Weekdy = 3 Then
       LastTwoDays = Now() - Weekday(Now(), 3)
    ElseIf Weekdy = 4 Then
       LastTwoDays = Now() - Weekday(Now(), 3)
    ElseIf Weekdy = 5 Then
       LastTwoDays = Now() - Weekday(Now(), 3)
    ElseIf Weekdy = 6 Then
       LastTwoDays = Now() - Weekday(Now(), 3)
    Else
       MsgBox "Today Satuarday OR Sunday Data is not Available"
    End If

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=12, Criteria1:="="

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=11, Criteria1:="<>"

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=11, Criteria1:=" TodayDT", Operator:=xlAnd, Criteria2:="LastTwoDays"

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).Copy

    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "DRfeefollowup"

    Set Drfreefolup = ThisWorkbook.Worksheets("DRfeefollowup")

    Drfreefolup.Range("A1").PasteSpecial Paste:=xlPasteValues

    Application.CutCopyMode = False

    Data.AutoFilterMode = False

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=15, Criteria1:="yes"

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=19, Criteria1:="x"

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=12, Criteria1:="<>"

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=13, Criteria1:="<>"

    'Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=14, criterial:="<>"

    Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).Copy

    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Drworkblefiles"

    Set Drworkblefiles = ThisWorkbook.Worksheets("Drworkblefiles")

    Drworkblefiles.Range("A1").PasteSpecial Paste:=xlPasteValues

    Application.CutCopyMode = False

    Data.Range("A1").AutoFilter

   End Sub

 Private Sub CommandButton2_Click()


    Sheets("Data").Range("A1:AJ" & Sheets("Data").Range("A1").End(xlDown).Row).Clear

    MsgBox "Please paste new data in data sheet"


End Sub

来源：https://stackoverflow.com/questions/19817399/subscript-out-of-range-error-in-this-excel-vba-script

标签

excel

vba

csv

range

ms-error-9