时间戳

首页 > 解决方案 > 获取和传输特定工作表中的文件

vba - 获取和传输特定工作表中的文件

问题描述

我目前正在做一份报告，其中我将根据我在特定单元格中指示的链接/路径和文件名获取报告，并且数据应该在我还指示的特定工作表中传输。这是必需的，因为路径总是根据用户保存文件的位置而变化。

第一件事是，我有“列表”选项卡，我在其中输入了每个文件的文件名和完整路径，以及应该粘贴在什么位置。例如，文件 A 应粘贴到“MasterData”表。文件 B 应该在下一个选项卡中，文件 C 应该在另一个选项卡中。

然后，当我使用 vba 时，它会获取我的文件。文件已被复制到“MasterData”表，但第二个和第三个文件被复制到文件 A 的数据下，这是我的问题。

第二个文件和第三个文件也是文本格式，但我希望首先弹出文本向导，以便用户可以在将数据复制到分配的工作表之前选择是定界还是固定宽度。

清单表 清单表

主数据表结果 主数据表结果

我无法在此处附加我的文件:(

这是我当前的 VBA 代码：

Public strFileName As String
Public currentWB As Workbook
Public dataWB As Workbook
Public strCopyRange As String

Sub GetData()
    Dim strWhereToCopy As String, strStartCellColName As String
    Dim strListSheet As String

    strListSheet = "List"

    On Error GoTo ErrH
    Sheets(strListSheet).Select
    Range("B2").Select

    'this is the main loop, we will open the files one by one and copy their data into the masterdata sheet
    Set currentWB = ActiveWorkbook
    Do While ActiveCell.Value <> ""

        strFileName = ActiveCell.Offset(0, 1) & ActiveCell.Value
        strCopyRange = ActiveCell.Offset(0, 2) & ":" & ActiveCell.Offset(0, 3)
        strWhereToCopy = ActiveCell.Offset(0, 4).Value
        strStartCellColName = Mid(ActiveCell.Offset(0, 5), 2, 1)

        Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=False
        Set dataWB = ActiveWorkbook

        Range(strCopyRange).Select
        Selection.Copy

        currentWB.Activate
        Sheets("MasterData").Select
        lastRow = LastRowInOneColumn(strStartCellColName)
        Cells(lastRow + 1, 1).Select

        Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        Application.CutCopyMode = False
        dataWB.Close False
        Sheets("List").Select
        ActiveCell.Offset(1, 0).Select


    Loop


    Exit Sub

ErrH:
    MsgBox "It seems some file was missing. The data copy operation is not complete."
    Exit Sub
End Sub

Public Function LastRowInOneColumn(col)
    'Find the last used row in a Column: column A in this example
    'http://www.rondebruin.nl/last.htm
    Dim lastRow As Long
    With ActiveSheet
    lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
    End With
    LastRowInOneColumn = lastRow
End Function

标签： vbaexcel

解决方案

我怀疑要解决粘贴问题，该行显示为：

Sheets("Master Data").select

应该读

Sheets(strWhereToCopy).select

推荐阅读