从不同的工作簿VBA

Question

我有一个代码，如下所示，从一个文件夹中的不同工作簿中导入数据。我尝试它并且它完美地工作但是我想知道是否有人可以帮助我改进它。

我解释说：“zmaster.xlms”工作簿是第1页中所有数据都过去的工作簿。在sheet2的同一个工作簿中，我有一个这样的表：

“Excel列代码”列是数据应该过去的位置（在“zmaster.xlms”中），“表格单元格代码”对应于应从每个工作簿中复制的单元格（在同一个工作簿中）我桌面上的文件。）

问题：如何对宏查看表并复制单元格K26并将其移过zmaster文件的columnA并循环直到表的末尾？

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

您需要做的就是遍历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

Answer 2

目前你编码

<label class="item item-input">
              <input type="date" placeholder="Start date"  ng-model="localPlacementStep.starts_at">
            </label>

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

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

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

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