Question

这里的第一次海报。我整天都在阅读教程/指南，并且取得了很大的进步，但我很难搞清楚如何编写一个能够做我想做的宏。

我每周大约收到100张时间表，然后将其复制并导入到会计软件中。这些工作表都基于模板，位于单独的工作簿中，并且有一个标题为＆＃34; Pre Import Time Card＆＃34;在他们里面。我将每本书的预导入工作表中的值复制到一个新文件中，并将它们作为批处理上传到我们的会计软件中。

我想让宏自动打开每个文件，复制每个工作簿上的范围A1：I151，然后将值粘贴到新工作表中。由于导入模板设计，这不可避免地导致指定范围内的许多空行。我想删除任何空白行作为最后一步。

更新：我已经复制了代码，以反映我目前所拥有的内容。下面列出了一些新问题。

粘贴到下一个未使用的行无法正常工作
我需要弄清楚如何杀死旧文件/没有它两次输入相同的文件。
我想抑制VBA / Active X控件上的＆＃34;隐私警告＆＃34;每次保存时出现的对话框。
目前没有正确复制。我在rDest.Resize行遇到了一个错误。
未设置对象变量或使用块变量。

我在数组中使用文件名时运行它，但决定这是不必要的并使用For .. Each循环。

Sub CopySourceValuesToDestination()

    Dim wbDest As Workbook
    Dim wbSource As Workbook
    Dim sDestPath As String
    Dim sSourcePath As String
    Dim aFile As String
    Dim shDest As Worksheet
    Dim rDest As Range
    Dim i As Long
    Dim TSSize As Object
    Dim objFso As Object 'New FileSystemObject
    Dim objFolder As Object 'Folder
    Dim objFile As Object 'File
    Set objFso = CreateObject("Scripting.FileSystemObject")

    sDestPath = "Z:\Dropbox\My Documents\TimeSheets\Processed\"
    sSourcePath = "Z:\Dropbox\My Documents\TimeSheets\Copying\"

    'Open the destination workbook at put the destination sheet in a variable
    Set wbDest = Workbooks.Open(sDestPath & "Destination.xlsm")
    Set shDest = wbDest.Sheets(1)

    Set objFolder = objFso.GetFolder(sSourcePath)

    For Each objFile In objFolder.Files
    aFile = objFile.Name
    Set objWb = Workbooks.Open(sSourcePath & aFile)

        'find the next cell in col A
        Set rDest = shDest.Cells(xlLastRow + 1, 1)
        'write the values from source into destination
        TSSize = wbSource.Sheets(4).Range("A1").End(xlDown).Row
        rDest.Resize(TSSize, 9).Value = wbSource.Sheets(4).Range("A1:I" & TSSize).Value

        wbSource.Close False
        wbDest.SaveAs sDestPath & "Destination.xlsm"
        wbDest.Close
        Kill sSourcePath & wbSource
        Next
End Sub
Function xlLastRow(Optional WorksheetName As String) As Long

     '    find the last populated row in a worksheet

    If WorksheetName = vbNullString Then
        WorksheetName = ActiveSheet.Name
    End If
    With Worksheets(1)
        xlLastRow = .Cells.Find("*", .Cells(1), xlFormulas, _
        xlWhole, xlByRows, xlPrevious).Row
    End With

End Function

Answer 1

在时间表中记录您的数据范围是连续的，您可以替换

rDest.Resize(151,9).Value = wbSource.Sheets(1).Range("A1:I151").Value

与

var for storing 
dim TSsize as long

TSsize = wbSource.Sheets(1).Range("A1").end(xlDown).Row
rDest.Resize(TSsize,9).Value = wbSource.Sheets(1).Range("A1:I" & TSsize).Value

这可以防止空行首先进入您的工作表。

如果每个时间表不是连续范围，您可以在行中查找空行并删除它们。如果是这种情况，请告诉我，我会更新我的答案。

复制范围，粘贴到新工作簿，多个文件，删除空行

1 个答案: