1
votes

Please help! I've a problem that I've been stuck with for the past day.

I need to transfer data from one sheet to another sheet in another workbook. The output row corresponds to a value in input column a, and output column corresponds to a date in input sheet column B.

I've previously dim-ed the input/out workbooks/sheets as wbin,wbout,sheetin,sheetout respectively. Could anyone help see where my problem is? The error I get is runtime error '9': subscript out of range in the copy destination line.

Windows(wbin).Activate
Sheets(sheetin).Select

iMaxRow = 5000
Dim subj1 As String
Dim subj2 As String
For iRow = 1 To iMaxRow

    subj1 = Range("B" & iRow).Text
    subj2 = Range("A" & iRow).Text

    With Workbooks(wbin).Sheets(sheetin).Cells(iRow, 3)
'On Error Resume Next

    .Copy Destination:=Workbooks(wbout).Worksheets(sheetout).Cells(WorksheetFunction.Match(subj2 & "*", _
    Workbooks(wbout).Sheets(sheetin).Columns(2), 0) & _
    WorksheetFunction.Match(subj1, Workbooks(wbout).Sheets(sheetin).Rows(2), 0) + 1)
    End With

Next iRow

For now, i've disabled the on error resume next. Also, the input column a has 4 numbers followed by string, while the corresponding output row header only has the 4 numbers, hence I tried matching with the wildcard.

Any advice would be really appreciated!

1

1 Answers

0
votes

This is the correct way to solve your problem. You need to use 'Range.Find' instead of 'WorksheetFunction.Match'.

Dim dateHeader as Range, foundCell as Range
Set dateHeader = Workbooks(wbout).Worksheets(sheetout).Rows(2)
Set foundCell = dateHeader.Find(subj1)

.Copy Intersect(foundCell.EntireColumn, Workbooks(wbout).Worksheets(sheetout).Rows(subj2))