• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro Range Solution

I have code that copy column value base on header name & paste in other sheet with specific range
I have found error in range.
Code:
Sub RawData()
    Dim Header As Variant
    Dim x As Long, i As Long
    Dim FromColumn As Range

    Header = Array("Date", "Num", "Name", "Item", "Type", "Via", "Paid", "Qty", "Sales Price", "Amount", "Customer", "Bill to", "Balance Total")

    x = 1

    For i = LBound(Header) To UBound(Header)
        With ThisWorkbook.Sheets("RawData").Rows(1)
            Set FromColumn = .Find(Header(i), after:=.Cells(1, 1), MatchCase:=False)
        End With

        If Not FromColumn Is Nothing Then
         
            FromColumn.EntireColumn.Copy Destination:=Sheets("Raw Data").Cells(7, 4 + x)

        x = x + 1
        End If
    Next i

End Sub
 
Hello FaizanRoshan88

Tried to do other way round...Hope you like it

Code:
Sub RawData()

Dim Header As Variant
Header = Array("Date", "Num", "Name", "Item", "Type", "Via", "Paid", "Qty", "Sales Price", "Amount", "Customer", "Bill to", "Balance Total")
Dim i As Long

For i = 0 To UBound(Header)


    Sheets("RawData").Select
   
   
    On Error GoTo ErrHandler
        Cells.Find(What:=Header(i), After:=Range("A1"), _
        LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns).EntireColumn.Copy
    On Error GoTo 0
   
    Sheets("Raw Data").Select
    Range("c1").Offset(0, i).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False


NextOne:
Next i

Exit Sub

ErrHandler:
Resume NextOne
End Sub
 
One problem is the 7 in this part of your code:
Destination:=Sheets("Raw Data").Cells(7, 4 + x)

You're trying to copy an entire row (all 1 million+ rows of it) to a destination starting at row 7. It's not going to fit.

Either change that 7 to a 1 or copy less stuff over: use this line in place of your existing one:
Code:
Intersect(ThisWorkbook.Sheets("RawData").UsedRange, FromColumn.EntireColumn).Copy Destination:=Sheets("Raw Data").Cells(7, 4 + x)
 
Last edited:
Back
Top