I am trying to transfer data from one sheet to another sheet based on the column header, but not for-CodePudding

I am trying to transfer data from one sheet to another sheet based on the column header, the code is working fine, but i need one change that if there is any column which has color index-RGB(237,125,49), thn do not copy the data for that column. Old sheet is source sheet and sheet1 is target sheet.

 Option Explicit

Sub Transfer()


Dim wb As Workbook: Set wb = ThisWorkbook


Dim sws As Worksheet: Set sws = wb.Worksheets("Old Sheet")


Dim sdrg As Range
Dim shData() As Variant
Dim srCount As Long
Dim scCount As Long
    

Dim dws As Worksheet
Dim drg As Range
Dim dhData() As Variant
Dim dcCount As Long
Dim dc As Long
Dim dHeader As String
Set dws = wb.Worksheets("Sheet1")

With sws.Range("A1").CurrentRegion
    
    shData = .Rows(1).Value
   
    
    srCount = .Rows.Count - 1

    scCount = .Columns.Count
  
    Set sdrg = .Resize(srCount).Offset(1)
End With


Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare


Dim sc As Long


For sc = 1 To scCount
    dict(CStr(shData(1, sc))) = sdrg.Columns(sc).Value
Next sc



With dws
    If Not dws Is sws Then
        
        With dws.Range("A1").CurrentRegion
            
            dhData = .Rows(1).Value
           
            dcCount = .Columns.Count
           
            Set drg = .Resize(srCount).Offset(.Rows.Count)
        End With
       
        For dc = 1 To dcCount
      
            dHeader = CStr(dhData(1, dc))
           
            If dict.Exists(dHeader) Then
               drg.Columns(dc).Value = dict(dHeader)
            End If
         
        Next dc
   
    End If
 End With
End Sub

Please Help me with this thing.

CodePudding user response：

I haven't checked your entire code, just the part where the dict variable is populated. If your goal is to skip columns where the first cell is RGB(237, 125, 49) colored, then this would be a solution

For sc = 1 To scCount
    If sdrg.Columns(sc).Cells(1, 1).Offset(-1).Interior.Color <> RGB(237, 125, 49) Then
        dict(CStr(shData(1, sc))) = sdrg.Columns(sc).Value
    End If
Next sc