нупур, это ты что пытаешься?
Option Explicit
Sub Sample()
Dim aCell As Range, bCell As Range
Dim ws As Worksheet
Dim ExitLoop As Boolean
For Each ws In ThisWorkbook.Sheets
Set aCell = ws.Rows(1).Find(what:="Date", LookIn:=xlValues, _
lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
ExitLoop = False
If Not aCell Is Nothing Then
Set bCell = aCell
ws.Columns(aCell.Column).NumberFormat = "dd/mm/yyyy;@"
Do While ExitLoop = False
Set aCell = ws.Rows(1).FindNext(After:=aCell)
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
ws.Columns(aCell.Column).NumberFormat = "dd/mm/yyyy;@"
Else
ExitLoop = True
End If
Loop
End If
Next
End Sub
Followup
Причина, по которой вы получаете эти ошибки, заключается в том, что ваш столбец отформатирован как текст. Попробуй это. Это работает:)
Option Explicit
Sub Sample()
Dim aCell As Range, bCell As Range
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim ExitLoop As Boolean
For Each ws In ThisWorkbook.Sheets
Set aCell = ws.Rows(1).Find(what:="Date", LookIn:=xlValues, _
lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
ExitLoop = False
If Not aCell Is Nothing Then
Set bCell = aCell
ws.Columns(aCell.Column).NumberFormat = "dd/mm/yyyy;@"
lastRow = ws.Range(Split(ws.Cells(, aCell.Column).Address, "$")(1) & _
ws.Rows.Count).End(xlUp).Row
For i = 2 To lastRow
With ws.Range(Split(ws.Cells(, aCell.Column).Address, "$")(1) & i)
.FormulaR1C1 = .Value
End With
Next i
ws.Columns(aCell.Column).AutoFit
Do While ExitLoop = False
Set aCell = ws.Rows(1).FindNext(After:=aCell)
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
ws.Columns(aCell.Column).NumberFormat = "dd/mm/yyyy;@"
lastRow = ws.Range(Split(ws.Cells(, aCell.Column).Address, "$")(1) & _
ws.Rows.Count).End(xlUp).Row
For i = 2 To lastRow
ws.Range(Split(ws.Cells(, aCell.Column).Address, "$")(1) & i).FormulaR1C1 = _
ws.Range(Split(ws.Cells(, aCell.Column).Address, "$")(1) & i).Value
Next i
Else
ExitLoop = True
End If
Loop
End If
Next
End Sub
НТН
Sid