需要遍历多个文件中的多个工作表,并在每个工作表中添加一列

时间:2018-10-22 16:34:53

标签: excel vba

Sub LoopAllExcelFilesInFolder()


Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim i As Integer
Dim WS_Count As Integer

  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With
  myExtension = "*.xls*"
  myFile = Dir(myPath & myExtension)

  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)

      WS_Count = ActiveWorkbook.Worksheets.Count

    For i = 4 To WS_Count
        ActiveWorkbook.Sheets(i).Select
        With ActiveWorkbook.Sheets(i)
            Set RngCol = .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
        End With
            LastRow = RngCol.Rows.Count
            Range("L1:L" & LastRow).Value = ActiveWorkbook.Name
    Next i

      wb.Close SaveChanges:=True

      myFile = Dir

End Sub

0 个答案:

没有答案