How to Copy data from Sheet 1 to sheet 3 by using sheet 2 (Contains Regex of each column)

Maybe :

Sub Test()
  Dim arrData, arrCons, arrOk, i As Long, j As Long, m As Long, n As Long, strReport As String

  'Get Array of Data
  With Sheets("Sheet1")
    arrData = .Range("A1").CurrentRegion.Value
  End With

  'Get Array of Constraint
  With Sheets("Sheet2")
    arrCons = .Range("A1").CurrentRegion.Value
  End With

  'Set dimension for Array OK/NG
  ReDim arrOk(1 To UBound(arrData, 1), 1 To 1)

  'Convert field name to column number
  For i = 2 To UBound(arrCons, 1)
      For j = 1 To UBound(arrData, 2)
          If arrCons(i, 1) = arrData(1, j) Then
             arrCons(i, 1) = j
             Exit For
          End If
      Next j
  Next i

  'Warn if there is/are unknown fields
  For i = 2 To UBound(arrCons, 1)
      If Not IsNumeric(arrCons(i, 1)) Then strReport = strReport & "," & arrCons(i, 1)
  Next i
  If Len(strReport) Then
     MsgBox "Unrecognized fields : " & Mid$(strReport, 2)
     Exit Sub
  End If

  'Check for length constraint
  For j = 2 To UBound(arrCons, 1)
      m = arrCons(j, 1)
      n = arrCons(j, 3)
      For i = 2 To UBound(arrData, 1)
          If Len(arrData(i, m)) > n Then arrOk(i, 1) = "NG"
      Next i
  Next j

  'Check for regular expression
  With CreateObject("VBScript.RegExp")
    .Global = True
    For j = 2 To UBound(arrCons, 1)
        m = arrCons(j, 1)
        .Pattern = arrCons(j, 2)
        For i = 2 To UBound(arrData, 1)
            If arrOk(i, 1) <> "NG" Then
               If Not .Test(arrData(i, m)) Then arrOk(i, 1) = "NG"
            End If
        Next i
    Next j
  End With
  arrOk(1, 1) = "OK/NG"
  For i = 2 To UBound(arrOk, 1)
      If arrOk(i, 1) <> "NG" Then arrOk(i, 1) = "OK"
  Next i

  'Put Result
  With Sheets("Sheet3")
    .Cells.Clear
    With .Range("A1").Resize(UBound(arrData, 1), UBound(arrData, 2) + 1)
      .Value = arrData
      .Columns(.Columns.Count).Value = arrOk

      .AutoFilter field:=.Columns.Count, Criteria1:="OK"
      On Error Resume Next
         .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 4
      On Error GoTo 0
      .AutoFilter field:=.Columns.Count, Criteria1:="NG"

      On Error Resume Next
         .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 3
      On Error GoTo 0

      .AutoFilter
    End With
  End With
End Sub

Code is working well but if i change data in Account Number to "asd"(Wrong data) then after checking regular expression it showing OK.

Do you understand regular expression syntax ?
From your screenshot, on Sheet2!B2, the regular expression for "Account Number" is "^[a-zA-Z0-9]+$"
This means: lowercase a to z, uppercase A to Z, number 0 to 9 should be allowed, but you said "asd" is wrong data ?
If you want this column is number only, then the regular expression should be "^[0-9]+$" (just the same as for the Bank Code on cell Sheet2!B9)

Also for "Address", "Bank Name", "Bank Branch", "Bank Address", your regular expression is "^[A-Z0-9\s/\-\?:\(\)\.,'\+]+$"
Notice that there is no a-z, which means lowercase is forbidden, but from your screenshot on post #3, for cell B2 for example, you mark this cell as green while it should be red (lowercase is forbidden).

-----------------------------------

This is the modified code as your request to test and mark individual cell (not whole row) :

Sub Test()
  Dim cell As Range, arrData, arrCons, arrOk, i As Long, j As Long, m As Long, n As Long, strReport As String
  With Sheets("Sheet1")
    arrData = .Range("A1").CurrentRegion.Value
  End With
  With Sheets("Sheet2")
    arrCons = .Range("A1").CurrentRegion.Value
  End With
  ReDim arrOk(1 To UBound(arrData, 1), 1 To 1)
  For i = 2 To UBound(arrCons, 1)
      For j = 1 To UBound(arrData, 2)
          If arrCons(i, 1) = arrData(1, j) Then
             arrCons(i, 1) = j
             Exit For
          End If
      Next j
  Next i
  For i = 2 To UBound(arrCons, 1)
      If Not IsNumeric(arrCons(i, 1)) Then strReport = strReport & "," & arrCons(i, 1)
  Next i
  If Len(strReport) Then
     MsgBox "Unrecognized fields : " & Mid$(strReport, 2)
     Exit Sub
  End If
  For j = 2 To UBound(arrCons, 1)
      m = arrCons(j, 1)
      n = arrCons(j, 3)
      For i = 2 To UBound(arrData, 1)
          If Len(arrData(i, m)) > n Then
             arrData(i, m) = Chr$(2)
             arrOk(i, 1) = "NG"
          End If
      Next i
  Next j
  With CreateObject("VBScript.RegExp")
    .Global = True
    For j = 2 To UBound(arrCons, 1)
        m = arrCons(j, 1)
        .Pattern = arrCons(j, 2)
        For i = 2 To UBound(arrData, 1)
            If arrData(i, m) <> Chr$(2) Then
               If Not .Test(arrData(i, m)) Then
                  arrData(i, m) = Chr$(2)
                  arrOk(i, 1) = "NG"
               End If
            End If
        Next i
    Next j
  End With
  arrOk(1, 1) = "OK/NG"
  For i = 2 To UBound(arrOk, 1)
      If arrOk(i, 1) <> "NG" Then arrOk(i, 1) = "OK"
  Next i
  With Sheets("Sheet3")
    .Cells.Clear
    Sheets("Sheet1").Range("A1").CurrentRegion.Copy .Range("A1")
    For j = 1 To UBound(arrData, 2)
        For i = 2 To UBound(arrData, 1)
            If arrData(i, j) = Chr$(2) Then
               .Cells(i, j).Interior.ColorIndex = 3
            Else
               .Cells(i, j).Interior.ColorIndex = 4
            End If
        Next i
    Next j
    With .Range("A1").CurrentRegion
      With .Offset(, .Columns.Count + 1).Resize(, 1)
        .Value = arrOk
        For Each cell In .Cells
            If cell.Value = "NG" Then
               cell.Interior.ColorIndex = 3
            Else
               cell.Interior.ColorIndex = 4
            End If
        Next cell
      End With
    End With
  End With
End Sub

You are welcome.

It's up to you which method you will choose. Here I provide the second method, this Sub Test2() will call Sub Test() and then copy the output to a new workbook.
If you want the first method, then just add the code of this SubTest2() to the end of Sub Test() (remove the "Call Test" line).

Sub Test2()
  Dim rng As Range, strLocation As String

  Call Test

  strLocation = "Z:\Report.xls"
  If Len(Dir(strLocation)) Then Kill strLocation

  Set rng = Sheets("Sheet3").Range("A1").CurrentRegion
  With Workbooks.Add
    With .Worksheets.Add
      rng.Copy .Range("A1")
    End With
    .SaveAs Filename:="Z:\Report.xls", FileFormat:=xlWorkbookNormal
    Application.DisplayAlerts = False
      .Close savechanges:=False
    Application.DisplayAlerts = True
  End With
End Sub

Thank you very much for your Answer........!!!!!!!!!!!
Code is Running Properly.........!!!!!!!!!!!

i wants to make header name in "Report.xls" in Blue Color and all columns should be autofilterd.
and i wants to store ouput file path is given in sheet4. Where should i make changes.
Cap.JPG

Sub Test2()
  Dim rng As Range, strLocation As String

  Call Test

  strLocation = Sheets("Sheet4").Range("B3").Value
  If Right$(strLocation, 1) <> "\" Then strLocation = strLocation & "\"
  strLocation = strLocation & "Report.xls"
  If Len(Dir(strLocation)) Then Kill strLocation

  Set rng = Sheets("Sheet3").Range("A1").CurrentRegion
  With Workbooks.Add
    With .Sheets(1)
      rng.Copy .Range("A1")
      With .Range("A1").CurrentRegion
        .EntireColumn.AutoFit
        .Rows(1).Interior.ColorIndex = 41
        .AutoFilter
      End With
    End With
    .SaveAs Filename:=strLocation, FileFormat:=xlWorkbookNormal
    Application.DisplayAlerts = False
      .Close savechanges:=False
    Application.DisplayAlerts = True
  End With
End Sub

Thank you code is working very well....!!!!!!!!!!

But the problem is i have executed it first time the report is file is generated successfully. Without deleting the report.xls file from output path , i tried to execute code second time, the second report.xls file is not get generated but previous file gets overwrited. when i go to execute it for second time it should not overwrite previous file new file should be created.