Question

我正在尝试从特定文件夹中的所有工作表中导入Sheet1的特定范围。我从这个Loop through all worksheets in all Excel workbooks in a folder to change the font, font size, and alignment of text in all cells开始，但对VBA不熟悉需要一些帮助来完成以下任务。

具体而言。

仅在目录中的每个文件中从Sheet1导入范围（“A3：J4”）。但请将其格式化为从B列开始以适应：

将A列设置为每个范围来自的文件名。

范围（A3：J4）将转到第一个文件的范围（B1：K2），然后范围（B3：K4）等。第一个文件的文件名为A1，然后是第二个文件A3。然后列表将继续使用此模式构建文件夹

中的所有文件

Sub FormatFiles()
Const fPath As String = "D:\DataFolder\"
Dim sh As Worksheet
Dim sName As String

With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With

sName = Dir(fPath & "*.xls*")

Do Until sName = ""
    With GetObject(fPath & sName)
        For Each sh In .Worksheets
            With sh
                .Cells.HorizontalAlignment = xlLeft
                .Cells.Font.Name = "Tahoma"
                .Cells.Font.Size = 10
            End With
        Next sh
        .Close True
    End With
    sName = Dir
Loop

With Application
    .Calculation = xlAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub

感谢您的帮助。

Answer 1

你想要这样的东西吗？

Const fPath As String = "z:\docs\xlfiles\"
Dim sName As String
Dim intRow As Integer
Dim strCopyAddress As String
Dim wb As Workbook

strCopyAddress = "A3:J4"

Application.ScreenUpdating = False

sName = Dir(fPath & "*.xls*")
intRow = 1

Do Until sName = ""
    Set wb = Workbooks.Open(fPath & sName)
    ThisWorkbook.Sheets("Sheet1").Cells(intRow, 1) = sName
    wb.Sheets("Sheet1").Range(strCopyAddress).Copy _
       ThisWorkbook.Sheets("Sheet1").Cells(intRow, 2)
    wb.Close False

    intRow = intRow + 2
    sName = Dir
Loop

Application.ScreenUpdating = True

Excel宏 - 从多个Excel文件中导入Sheet1的特定范围

1 个答案: