複製範圍，粘貼到新工作簿，多個文件，刪除空白行

第一次在這裏發佈海報。我一整天都在閱讀教程和指南，並且取得了很大的進步，但是我正在努力研究如何編寫一個能夠做我想做的事情的宏。複製範圍，粘貼到新工作簿，多個文件，刪除空白行

我避開每星期100張時被然後複製並導入到會計軟件。這些工作表均基於模板，在單獨的工作簿中，並在其中有一個標題爲「Pre Import Time Card」的工作表。我將每本書的預導入工作表中的值複製到一個新文件中，並作爲一批上傳到我們的會計軟件中。

我想有一個宏自動打開每個文件，複製範圍A1：I151每個工作簿，然後將值粘貼到一個新的工作表。由於導入模板設計，這不可避免地導致指定範圍內的許多空白行。我想刪除任何空行作爲最後一步。

UPDATE：我抄代碼來反映我目前HAVE.Also的新問題列表如下。

粘貼到一個未使用的行不工作
我需要弄清楚如何殺死舊的文件/沒有它進入同一個文件的兩倍。
我想打壓「隱私對VBA/Active X控件警告」對話框，在每次保存上來。
目前尚未正確複製。我在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

來源

2012-01-26 kevins

曾認爲你只是在對結果排序使坯料最終在底部進行分組並刪除它們？或者在複製粘貼之前自動過濾空白？ – datatoo

數據範圍不連續..空白位於不可預測的位置。 – kevins

如果可以在宏中使用空格，我可以在後面或之前對空格進行排序，但是當手動排序時，記錄有時會位於頂部，而一個雜散則會位於底部。空白單元格實際上全都有0位於E列，因爲使用的公式在0個工時內創建了0行。 – kevins

Provded你的時間表datarange是連續的，你可以替換

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

這是防止進入你的表擺在首位的空行。

如果每個時間片是不是可以通過尋找空行和刪除它們的行interate連續範圍。讓我知道如果是這樣，我會更新我的答案。

來源

2012-01-26 16:55:19 Pynner

複製範圍，粘貼到新工作簿，多個文件，刪除空白行

回答

相關問題