При выполнении приведенного ниже кода он работает для одной рабочей книги Excel, но при попытке сделать то же самое с другой рабочей книгой выдает ошибку времени выполнения при поиске первого пустого столбца
Я попытался изменитькод, применяя различные значения, но он работает только для одной рабочей книги Excel. Но, насколько я знаю, я не написал ничего статического, связанного с одной рабочей книгой, в моем коде
unusedcolumn = Rows(1).SpecialCells(xlCellTypeBlanks)(1).Column
'Open a excel file
'Find last cell number of row A from data sheet
'Find the first blank column
'Add rule run date to first blank column
'Find age and convert to years
'sort by small to high by age column
Sub age()
Dim OpenWb As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
'Makes sure the user can select only one file
.AllowMultiSelect = False
'Filter to just the following types of files to narrow down selection options
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
'Show the dialog box
.Show
'Store in fullpath variable
fullpath = .SelectedItems.Item(1)
'Actions in raw data sheet
Set OpenWb = Workbooks.Open(fullpath)
Dim wsData As Worksheet
Set wsData = OpenWb.Worksheets("Sheet1")
' Find last cell number of row A from data sheet
Dim last As Double
Dim Cell As Range
With OpenWb.Worksheets("Sheet1")
last = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
OpenWb.Worksheets("Sheet1").Range("A1").Select
OpenWb.Worksheets("Sheet1").ListObjects.Add(xlSrcRange, Selection.CurrentRegion, , xlYes).Name = _
"MyTable"
'Find the first blank column
Dim unusedcolumn As Range
unusedcolumn = Rows(1).SpecialCells(xlCellTypeBlanks)(1).Column
Dim irow As String
irow = Worksheets("Sheet1").Cells(Rows(unusedcolumn).Count, 1).End(xlUp).Row
'Add rule run date to first blank column
Cells(irow, unusedcolumn) = "Rule run date"
OpenWb.Worksheets("Sheet1").Select
Dim i As Double
For i = 1 To last - 1
Cells(irow + i, unusedcolumn).value = "11/15/2019"
Next i
'Find age
OpenWb.Worksheets("Sheet1").Rows("1:1").Select
Dim unusedcolumn2 As Integer
unusedcolumn2 = Rows(1).SpecialCells(xlCellTypeBlanks)(1).Column
Dim irow2 As String
irow2 = Worksheets("Sheet1").Cells(Rows(unusedcolumn).Count, 1).End(xlUp).Row
Cells(irow2, unusedcolumn2) = "Age"
OpenWb.Worksheets("Sheet1").Select
Dim J As Double
Cells(irow2 + 1, unusedcolumn2).Formula = "=MyTable[[#All],[Rule run date]]-MyTable[[#All],[BIRTH_YEAR]]"
'Covert age to years
Dim unusedcolumn3 As Integer
unusedcolumn3 = Rows(1).SpecialCells(xlCellTypeBlanks)(1).Column
Dim irow3 As String
irow3 = Worksheets("Sheet1").Cells(Rows(unusedcolumn).Count, 1).End(xlUp).Row
Cells(irow3, unusedcolumn3) = "Age in years"
OpenWb.Worksheets("Sheet1").Select
Dim k As Double
Cells(irow3 + 1, unusedcolumn3).Formula = "=DATEDIF(0, MyTable[[#All],[Age]], ""y"") & ""years"" & DATEDIF(0, MyTable[[#All],[Age]], ""ym"") & ""months"" & DATEDIF(0, MyTable[[#All],[Age]], ""md"") & "" days"""
Worksheets("Sheet1").UsedRange.value = Worksheets("Sheet1").UsedRange.value
OpenWb.Worksheets("Sheet1").Rows("1:1").Select
Dim f1 As String
f1 = Selection.Find(What:="Age", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Column
Selection.AutoFilter
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:=Cells( _
f1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub