コピー範囲、新しいブックへの貼り付け、複数のファイル、空白行の削除

Question

初めてのポスターです。私は一日中チュートリアルやガイドを読んでいましたが、多くの進歩を遂げましたが、私がやりたいことをするマクロを書く方法を考え出すのに苦労しています。

週に約100枚のタイムシートがコピーされ、会計ソフトウェアにコピーされてインポ​​ートされます。シートはすべてテンプレートに基づいており、別のワークブックにあり、その中に「Pre Import Time Card」というワークシートがあります。各書籍のインポート前のワークシートの値を新しいファイルにコピーし、会計ソフトウェアにバッチとしてアップロードします。

各ファイルを自動的に開くようにするには、各ワークブックにA1：I151の範囲をコピーして、新しいワークシートに値を貼り付けます。インポートテンプレートの設計のために、これは必然的に指定された範囲内の多くの空白の行につながります。私は最後のステップとして空白の行を削除したいと思います。

更新：私が現在持っているものを反映させるためにコードをコピーしました。新しい問題のリストも以下にあります。次の未使用の行に

• 貼り付けが
• 私は古いファイルを殺すためにどのように把握する必要があり機能していない/それは同じファイルを2回入力していません。
• 各保存時に表示される[VBA/Active Xコントロールのプライバシーに関する警告]ダイアログを表示しないようにしたいと思います。
• 現在正しくコピーされていません。 rDest.Resize行にバグがあります。
• オブジェクト変数またはWith Block Variableが設定されていません。

ファイル名を配列で使用しているときに実行していましたが、不要であると判断し、For .. Eachループを使用しました。タイムシートであなたのdatarangeをProvded

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

あなたは

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 

これが最初の場所であなたのシートになってから空の行を防ぐためであると

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

を置き換えることができ、連続的です。

各タイムシートが連続した範囲でない場合は、空の行を探して削除する行を介在させることができます。それが事実であれば教えてください。私は私の答えを更新します。