【问题标题】:Excel Macro - Import specific range from Sheet1 from multiple Excel filesExcel 宏 - 从多个 Excel 文件中的 Sheet1 导入特定范围
【发布时间】:2013-01-25 17:51:50
【问题描述】:

我正在尝试从特定文件夹中的所有工作表中导入来自 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 导入 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
    

感谢您的帮助。

【问题讨论】:

  • 每个工作表的范围(A3:J4)应该去哪里?具体告诉我们应该将第一张和第二张工作表中的输入范围放入哪个目标范围。 (我们大概可以从那里弄清楚)
  • range(A3:J4) 将转到第一个文件的 range(B1:K2),然后是 range(B3:K4) 等。第一个文件的文件名为 A1,然后是第二个文件 A3。然后列表将继续使用此模式构建文件夹中的所有文件。
  • 把这个放在你的问题中。
  • 我仍然无法理解所需的输入模式... %) 您能否提供屏幕截图或任何视觉示例?

标签: excel vba import


【解决方案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

【讨论】:

    猜你喜欢
    • 2021-06-07
    • 1970-01-01
    • 2019-05-18
    • 2021-12-17
    • 2018-11-25
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多