从不同的工作簿导入数据 VBA

Question

我有一段代码（见下文）用于从一个文件夹中的不同工作簿导入数据。我尝试了一下，效果很好，但是我想知道是否有人可以帮助我改进它。

我解释一下："zmaster.xlms"工作簿就是sheet里面所有数据过去的那一本。在 sheet2 中的同一工作簿中，我有一个 table，如下所示：

列 "Excel Column code" 是数据应该过去的地方（在 "zmaster.xlms" 中），而 "Form Cell Code" 对应于应该从每个工作簿中复制的单元格（在我桌面上的相同文件）。

问题：如何让宏查看 table 并复制单元格 K26 并将其粘贴到 zmaster 文件的 A 列中并循环直到 table 结束？

Dim MyFile As String
Dim erow
Dim Filepath As String

Filepath = "C:\Desktop\New folder\"
MyFile = Dir(Filepath)

Do While Len(MyFile) > 0
    If MyFile = "zmaster.xlsm" Then
    Exit Sub
    End If

    Workbooks.Open (Filepath & MyFile)
'    Range("A1:D1").Copy
    ActiveWorkbook.Close

    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4))

    MyFile = Dir
Loop

End Sub

预先感谢您的帮助！

Answer 1

在你编码的那一刻

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4))

只是将源工作表中第一行数据的 A 到 D 列复制到目标工作表中的新行。

我假设您仍想创建一个新的单行，但您希望 sheet2 上的 table 定义将哪些单元格放入新行的哪一列。

你需要这样写（未经测试）：

Sub YourCode()

    Dim MyFile As String
    Dim erow
    Dim Filepath As String

    Dim wbSource As Workbook
    Dim wsSource  As Worksheet
    Dim wsDestination As Worksheet

    Dim rngMapping As Range

    Dim DestinationRow As Long
    Dim cell As Range


    Filepath = "C:\Desktop\New folder\"
    MyFile = Dir(Filepath)

    Set wsDestination = ActiveWorkbook.Sheet1

     ' Named range "MappingTableFirstColumn" is defined as having the first column in the sheet2 table and all the rows of the table.
    Set rngMapping = ActiveWorkbook.Names("MappingTable").RefersToRange

    Do While Len(MyFile) > 0

        If MyFile = "zmaster.xlsm" Then
        Exit Sub
        End If

        Set wbSource = Workbooks.Open(Filepath & MyFile)
        Set wsSource = wbSource.Sheets("Sheet1")

        DestinationRow = wsDestination.Cells(wsDestination.Rows.Count, 1).End(xlUp).Offset(1, 0).Row

        For Each cell In rngMapping

            wsDestination.Range(cell.Value & DestinationRow) = wsSource.Range(cell.Offset(0, 1)).Value

        Next cell

        MyFile = Dir

    Loop

    ActiveWorkbook.Close

End Sub

Answer 2

您需要做的就是遍历 sheet 2 (zmaster.xlsm) 中的单元格。看看示例代码。请阅读评论。

[编辑]

代码已更新！

Option Explicit

'assuming that:
'- "Excel Column Code" is in column A
'- "Form Cell Code" is in column B
'in zmaster.xlsm!Sheet2


Sub UpdateData()
Dim sFile As String, sPath As String
Dim srcWbk As Workbook, dstWbk As Workbook
Dim srcWsh As Worksheet, dstWsh As Worksheet, infoWsh As Worksheet
Dim i As Long, j As Long, k As Long

On Error GoTo Err_UpdateData


Set dstWbk = ThisWorkbook
Set dstWsh = dstWbk.Worksheets("Sheet1")
Set infoWsh = dstWbk.Worksheets("Sheet2")

sPath = "C:\Desktop\New folder\"
sFile = Dir(sPath)
Do While Len(sFile) > 0
    If sFile = "zmaster.xlsm" Then
    GoTo SkipNext
    End If

    Set srcWbk = Workbooks.Open(sPath & sFile)
    Set srcWsh = srcWbk.Worksheets(1)
    i = 2
    'loop through the information about copy-paste method
    Do While infoWsh.Range("A" & i) <> ""
        'get first empty row, use "Excel Column Code" to get column name
        j = GetFirstEmpty(dstWsh, infoWsh.Range("A" & i))
        'copy data from source sheet to the destination sheet
        'use "Form Cell Code" to define destination cell
        srcWsh.Range(infoWsh.Range("B" & i)).Copy dstWsh.Range(infoWsh.Range("A" & i) & j)
        i = i + 1
    Loop
    srcwbk.Close SaveChanges:=False
SkipNext:
    sFile = Dir
Loop

Exit_UpdateData:
    On Error Resume Next
    Set srcWsh = Nothing
    Set dstWsh = Nothing
    Set srcWbk = Nothing
    Set dstWbk = Nothing
    Exit Sub

Err_UpdateData:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_UpdateData
End Sub

'returns first empty row in a destination sheet based on column name
Function GetFirstEmpty(ByVal wsh As Worksheet, Optional ByVal sCol As String = "A") As Long

GetFirstEmpty = wsh.Range(sCol & wsh.Rows.Count).End(xlUp).Row + 1

End Function

从不同的工作簿导入数据 VBA

Import data from different Workbooks VBA

import

vba