Блог

Итак, код состоит из двух частей.

Часть А) Откройте каталог папки и при нажатии кнопки ОК. Он запускает код части B. Затем сохраняет файл и, наконец, выводит сообщение msg.

Часть B) Он запускает код в файле.

Гипотеза: причина, по которой он не работает, заключается в двух строках кода. Я считаю, что первое — это инициирование запуска кода, а второе — это Set ws = ThisWorkbook.Sheets("report123")

Вот весь код

 Public Sub CommandButton1_Click()

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) amp; ""
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xlsx"

'Target Path with Ending Extention
  myFile = Dir(myPath amp; myExtension)

'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath amp; myFile)

    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
  

Мой код для файла начинается здесь

 ActiveSheet.Columns("A").Insert Shift:=xlToRight

ActiveSheet.Columns("A").Insert Shift:=xlToLeft


Range("A1").Value = "Source 2"

Range("B1").Value = "BU ID"

    Columns("I").Replace What:="eas", _
                            Replacement:="reC", _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            MatchCase:=False, _
                            SearchFormat:=False, _
                            ReplaceFormat:=False



Dim arrData As Variant, LastRow As Long, i As Long, ws As Worksheet

    Set ws = ThisWorkbook.Sheets("report123")
    With ws
        LastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
        arrData = .Range("A2", .Cells(LastRow, "C")).Value
        For i = 1 To UBound(arrData)
            If arrData(i, 3) Like "Bus*" Then
                arrData(i, 1) = "BU CRM"
            Else
                arrData(i, 1) = "CSI ACE"
            End If
            If arrData(i, 3) Like "CSI*" Or arrData(i, 3) = vbNullString Then
                arrData(i, 2) = vbNullString
            Else
                arrData(i, 2) = Right(arrData(i, 3), Len(arrData(i, 3)) - 12)
            End If
        Next i
        .Range("A2", .Cells(LastRow, "C")).Value = arrData
    End With
  

Мой код для файла заканчивается здесь

     wb.Close SaveChanges:=True


      DoEvents


      myFile = Dir
  Loop


  MsgBox "Task Complete!"

ResetSettings:

    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub