0

我正在尝试从特定文件夹中的所有工作表中从 Sheet1 导入特定范围。我从这个循环开始，遍历文件夹中所有 Excel 工作簿中的所有工作表，以更改所有单元格中文本的字体、字体大小和对齐方式，但是对于 VBA 的新手需要一些帮助来完成以下操作。

具体来说。

  • 仅在目录中的每个文件中从 Sheet1 导入 Range("A3:J4")。但将其格式化为从 B 列开始以适应：

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

    Range(A3:J4) 将转到第一个文件的 range(B1:K2)，然后是 range(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

谢谢您的帮助。

4

1 回答 1

0

你想要这样的东西吗？

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
于 2013-01-26T23:24:22.520 回答