Question

我有一个每日流程，我每天收到26个excel电子表格。我们手动打开这些电子表格打印它们，然后复制4个相关值并将它们粘贴到一个不同的工作簿中，以整合整个月的26页。到目前为止，我已经编写了以下代码，打开了26本书并打印出来。我认为在循环之前添加第二组代码将允许它找到4个值并将值粘贴到正确的位置（一旦代码完成）。我知道如何找到4个细胞，我只是不确定如何到达目的地。我有一个文本框，我输入要将数据放入当天的行，但是如何找到列，然后找到这两个的交集？

Sub LockBox2()

    'Opens all of the xls and xlsx files in the file path


    Dim DestRow As Variant
    DestRow = InputBox("Enter Desired Destination Row")

        Dim MyFolder As String
        Dim MyFile As String
        MyFolder = "C:\Users\ahendr1\Desktop\WIP Files\Lock Box Sheets Proj"

        MyFile = Dir(MyFolder & "\*.xls")
        Do While MyFile <> ""
        Workbooks.Open Filename:=MyFolder & "\" & MyFile


                ''''''''''''''''''''''''''''''''''''''
                '''''Prints the desired "Sheet 1" ''''
                ''''''''''''''''''''''''''''''''''''''

                    Dim sh As Worksheet
                        For Each sh In ActiveWorkbook.Worksheets
                        If (sh.Name = "Sheet1") Then
                           sh.PrintOut
                        End If
                    Next sh
                ''''''''''''''''''''''''''''''''''''''
                ''''''End of Print''''''''''''''''''''
                ''''''''''''''''''''''''''''''''''''''

        MyFile = Dir

        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ''''Insert Code To Copy 1st of 4 cell values in Lockbox sheet and paste into the destination sheet at ''''''''''''''''''''''''''''''
        '''' the intersection of the row entered into the dialogbox and the column header of the destination sheet''''''''''''''''''''''''''
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

        'Selects the desired cell to copy
            Dim GeneralRtnItems As Range
            Dim OffsetCell As Range
            With Sheets("Sheet1")
                Set GeneralRtnItems = .Cells.Find(what:="General Rtn Items")
                Set OffsetCell = GeneralRtnItems.Offset(0, -1)
            End With

            OffsetCell.Copy _
                Destination:=Workbooks("1-AugLockBox.xlsx").Worksheets("Summary").Range("F20")
        '''''''Code above sends the desired data to F20, but I need this to be dynamic and be Roww 22(from dialog box)
        '''''''and column where "17 Reg 04" is the column header
        '''''''Alternatively it could use the source workbook's name as the header in the destination workbook and use it to
        '''''''find the intersection and set the value in the cell


        '''''Enter Code to Close the Source File'''''''''''''''''''''
        '''''Will this work with the method that I am using to open the files on my desktop?
        '''''or will the loop never stop if I close the file (because there would always be an unopened file in the folder
        '''''could I close the file and move it to a completed folder to get around this potential issue?
        ''''''''''''''''''''''''''''''''''

        Loop


'''''''''''''''''''''''''
'''''''''''''''''''''''''
'''''''END STAGE 1'''''''
'''''''''''''''''''''''''
'''''''''''''''''''''''''

End Sub

Answer 1

将单元格复制到摘要表格，其中行为DestRow，列为＆＃34; 17 Reg 04＆＃34;在第1行中，使用：

With Workbooks("1-AugLockBox.xlsx").Worksheets("Summary")
    OffsetCell.Copy _
        Destination:=.Cells(DestRow, .Rows(1).Find(what:="17 Reg 04").Column)
End With

要将单元格复制到摘要表单，其中行为DestRow，并且第1行中包含当前文件名（忽略扩展名）的列，请先移动该行

MyFile = Dir

到复制单元格下面的某个地方（它通常最好放在循环结束之前），然后使用：

With Workbooks("1-AugLockBox.xlsx").Worksheets("Summary")
    OffsetCell.Copy _
        Destination:=.Cells(DestRow, .Rows(1).Find(what:=Left(MyFile, InstrRev(MyFile, ".") - 1)).Column)
End With

VBA查找和传输数据

1 个答案: