适配现有VBA宏代码清列、调整行高、自动调整列

我正在使用 Excel 2016

上一个问题/线程在这里

我有两个工作表“Data_Import”和“Pack”。

现有代码从 A 列的第一个空白单元格开始导入文件夹名称。然后对于具有新数据的每一行，它将行高设置为 18，将 A 列设置为自动调整，这非常有效。

我还需要清除“Data_Import”的 A 列中的所有数据，并从单元格 A1 开始并将行高设置为 18，将 A 列设置为自动调整。

对工作表“Pack”也执行相同的操作，并且对于具有新数据的每一行，它将行高设置为 18，将 A 列设置为自动调整。

我无法为具有新数据的每一行获取“打包”表，它将行高设置为 18，将 A 列自动调整为工作，宏将所有行的行高设置为 18，并且没有设置 AutoFit。

我将不胜感激任何建议，非常感谢。

我的其他问题中的现有代码

Sub GetFolderNames()
    Dim Answer As VbMsgBoxResult
    Dim xRow As Long
    Dim vSF As Object
    Dim xDirect$
    Dim InitialFoldr$
    Dim ws As Worksheet: Set ws = Sheets("Data_Import")
    Answer = MsgBox("Are you sure you want to run the macro - Import Folder Names", vbYesNo, "Run Import Folder Names Macro")
    If Answer = vbYes Then
        Application.ScreenUpdating = False
        xRow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
        InitialFoldr$ = "F:\" '<<< Startup folder to begin searching from
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = Application.DefaultFilePath & "\"
            .Title = "Please select a folder to list Files from"
            .InitialFileName = InitialFoldr$
            .Show
            If .SelectedItems.Count <> 0 Then
                xDirect$ = .SelectedItems(1) & "\"
            End If
        End With
        If xDirect$ <> "" Then
            With CreateObject("Scripting.FileSystemObject").GetFolder(xDirect$)
                For Each vSF In .subfolders
                    ws.Cells(xRow, 1) = Mid(vSF, InStrRev(vSF, "\") + 1)
                    xRow = xRow + 1
                Next vSF
            End With
            ws.Columns("A:A").AutoFit
        End If
    End If
End Sub

这就是我到目前为止尝试修改它的方式

Sub ClearAllGetNewFolderNames()
     
    Dim xRow&, vSF
    Dim xDirect$, InitialFoldr$
    Dim Answer As VbMsgBoxResult
    Dim x As Integer
    Dim y As Integer
    Dim myRow As Integer

    Answer = MsgBox("Are You Sure You Want To Clear All Existing " & vbNewLine & "Data Records Before Importing New Data", vbYesNo, "Import Data")
    InitialFoldr$ = "F:\" '<<< Startup folder to begin searching from
    
    If Answer = vbYes Then
        Sheets("Data_Import").Select
        Columns("A:A").Select
        Selection.ClearContents
        Range("A1").Select
        Rows.RowHeight = 10
        
    End If
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder to list Files from"
        .InitialFileName = InitialFoldr$
        .Show
        If .SelectedItems.Count <> 0 Then
            xDirect$ = .SelectedItems(1) & "\"
        End If
    End With
    
    If xDirect$ <> "" Then
        With CreateObject("Scripting.FileSystemObject").GetFolder(xDirect$)
            For Each vSF In .subfolders
                ActiveCell.Offset(xRow) = Mid(vSF, InStrRev(vSF, "\") + 1)
                xRow = xRow + 1
            Next vSF
        End With
        
    End If
    
        For x = 1 To ActiveSheet.UsedRange.Rows.Count
 
            ActiveSheet.UsedRange.Rows.RowHeight = 18
            Columns("A").EntireColumn.AutoFit
    Next x
        
        Sheets("Pack").Select
        
    For x = 1 To ActiveSheet.UsedRange.Rows.Count
        ActiveSheet.UsedRange.Rows.RowHeight = 18
        Columns("A:H").EntireColumn.AutoFit
    Next x

   
End Sub