Run Time Error 9 - Subscript out of range

Currently getting this Run Time Error With:

Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim Rng1 As Range
Dim Rng2 As Range
Dim c As Range

Application.ScreenUpdating = False
            Set WS1 = ThisWorkbook.Sheets("Tabelle1")
            Set WS2 = Workbooks("C:\Users\JeRi\Desktop\shortage\" & file).Sheets(file1)
            Set Rng1 = WS1.Range(WS1.Range("A5"), WS1.Range("A" & Rows.Count).End(xlUp))
            Set Rng2 = WS2.Range(WS2.Range("A2"), WS2.Range("A" & Rows.Count).End(xlUp))
            For Each c In Rng1
            On Error Resume Next
            Rng2.Find(What:=c).Offset(, 8).Resize(, 7).Copy Destination:=c.Offset(, 11)
            Err.Clear
            Next c
            Set WS1 = Nothing
            Set WS2 = Nothing
            Set Rng1 = Nothing
            Set Rng2 = Nothing
            Application.ScreenUpdating = True

Any Ideas why??

Thank You

JRidge

Originally Posted by TMS

Where are "file" and "file1" defined and what do they contain?


Regards, TMS

Path = "C:\Users\JeRi\Desktop\shortage\bom*"
file = Dir(Path) ' Retrieving the first Filename.
Do Until file = ""   ' Start the loop.
file1 = Left(file, InStrRev(file, ".") - 1)

Solved

Dim WS1 As Worksheet    Dim WS2 As Worksheet
    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim c As Range


Application.ScreenUpdating = False
            Set WS1 = ThisWorkbook.Sheets("Tabelle1")
            Set WS2 = Workbooks(file).Sheets(file1)
            Set Rng1 = WS1.Range(WS1.Range("A5"), WS1.Range("A" & Rows.Count).End(xlUp))
            Set Rng2 = WS2.Range(WS2.Range("A2"), WS2.Range("A" & Rows.Count).End(xlUp))
            For Each c In Rng1
            On Error Resume Next
            Rng2.Find(What:=c).Offset(, 7).Resize(, 7).Copy Destination:=c.Offset(, 11)
            Err.Clear
            Next c
            Set WS1 = Nothing
            Set WS2 = Nothing
            Set Rng1 = Nothing
            Set Rng2 = Nothing
            Application.ScreenUpdating = True

My problem is now:

Dim WS1 As Worksheet    Dim WS2 As Worksheet
    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim c As Range


Application.ScreenUpdating = False
            Set WS1 = ThisWorkbook.Sheets("Tabelle1")
            Set WS2 = Workbooks(file).Sheets(file1)
            Set Rng1 = WS1.Range(WS1.Range("A5"), WS1.Range("A" & Rows.Count).End(xlUp))
            Set Rng2 = WS2.Range(WS2.Range("A2"), WS2.Range("A" & Rows.Count).End(xlUp))
            For Each c In Rng1
            On Error Resume Next
            Rng2.Find(What:=c).Offset(, 7).Resize(, 7).Copy Destination:=c.Offset(, 11)
            Err.Clear
            Next c
            Set WS1 = Nothing
            Set WS2 = Nothing
            Set Rng1 = Nothing
            Set Rng2 = Nothing
            Application.ScreenUpdating = True

Basically instead of pasting the value 11 columns to the right of c i need to:

Find the Column with File1 value in.
The value is then pasted where the c Row and the File1 Column intersect.

Any Ideas would be greatly appreciated..

Regards

JRidge

Yeah i suppose

Doesn't help me work out how to code this part though

Got around it by using this:

TargetCol = ctr

Get the column number when i paste the name in earlier in the script.


Then:

Rng2.Find(What:=c).Offset(, 7).Resize(, 7).Copy Destination:=c.Offset(, TargetCol - 1)

and it works toooo

Regards

JRidge