Object Variable Not Set

Hello Mark,

If you only need values to be copied then the quickest way is to use an array. The system performs a "block transfer" with arrays. That is. all the data is written at once and not a single element at a time. You can copy the range into a Variant variable without having to dimension the rows and columns to be used. This method only works with the Value of a range.

 'This example copied the range A1:C10 from "Sheet1" to "Sheet2" starting at A1.

  Dim arrData As Variant
  Dim Rng As Range

    Set Rng = Worksheets("Sheet1").Range("A1:C10")
    arrData = Rng.Value

    Worksheets("Sheet2").Range("A1").Value = arrData

Hello Mark,

It sounds like the "CASH RECEIPTS" is a disparate (non contiguous) range of cells. You can loop through this range and then create a new range object of contiguous cells. It would help to see a sample of the data layout or your workbook.

Hello Mark,

Thanks for the workbook. I need to restart my computer because there seems to be a problem with file converter. I have Excel 2003 and downloaded the file converter for Office 2007. But as usual, there seems to be a glitch or two.

Hello Mark,

Thanks. I just got my system restarted and was able to convert the original file.

Hello Mark,

Here is the revised macro and it has been added to the attached workbook.

Sub JournalReceipts()

  Dim Area As Range
  Dim Cell As Range
  Dim Data(1 To 1, 1 To 7) As Variant
  Dim DstRng As Range
  Dim DstWks As Worksheet
  Dim I As Long
  Dim R As Long
  Dim RngEnd As Range
  Dim SrcRng As Range
  Dim SrcWks As Worksheet
  
    Set DstWks = Worksheets("Yearly Totals")
    Set SrcWks = Worksheets("Cash Receipts")
    
      Set SrcRng = ThisWorkbook.Names("Receipts").RefersToRange
      
      Set DstRng = DstWks.Range("B3:H3")
      Set RngEnd = DstWks.Cells(Rows.Count, DstRng.Column).End(xlUp)
      Set DstRng = IIf(RngEnd.Row < DstRng.Row, DstRng, RngEnd.Offset(1, 0))
      
      Data(1, 2) = "Cash"
      Data(1, 3) = "   ----------"
      Data(1, 5) = "   ---"
      Data(1, 7) = "   ---"
      
      For Each Area In SrcRng.Areas
        Data(1, 1) = Area.Item(1).Offset(-2, 0).Text
          For I = 1 To 14
            If Not IsEmpty(Area.Item(I)) Then
               Data(1, 4) = Area.Item(I).Value
                 Code = Area.Item(I).Offset(0, -1).Value
               Data(1, 6) = Switch(Code = "", "Food", Code = "fo", "Front Office", _
                                   Code = "h", "Hardware", Code = "c", "CTP", _
                                   Code = "o", "Other")
               DstRng.Offset(R, 0).Value = Data
               R = R + 1
            End If
          Next I
      Next Area
        
End Sub