Копировать диапазон, вставить в новую книгу, несколько файлов, удалить пустые строки - PullRequest
0 голосов
/ 26 января 2012

Первый постер здесь. Я читал учебные пособия / руководства весь день и сделал много шагов, но мне трудно понять, как написать макрос, который делает то, что я хочу.

Я получаю около 100 расписаний в неделю, которые затем копируются и импортируются в бухгалтерское программное обеспечение. Все листы основаны на шаблоне, находятся в отдельных рабочих книгах и имеют рабочий лист с заголовком «Pre Import Time Card». Я копирую значения из рабочего листа каждой книги перед импортом в новый файл и загружаю их в нашу бухгалтерскую программу в виде пакета.

Я хочу, чтобы макрос автоматически открывал каждый файл, копировал диапазон A1: I151 для каждой книги, а затем вставлял значения в новый лист. Из-за дизайна шаблонов импорта это неизбежно приводит ко многим пустым строкам в указанном диапазоне. Я хотел бы удалить все пустые строки в качестве последнего шага.

ОБНОВЛЕНИЕ: Я КОПИРОВАЛ КОД, ЧТОБЫ ОТРАЖАТЬ, ЧТО Я В НАСТОЯЩЕЕ ВРЕМЯ. Также ниже приведен список новых проблем.

  • вставка в следующую неиспользуемую строку не работает
  • Мне нужно выяснить, как убить старый файл / не вводить его дважды в один и тот же файл.
  • Я хотел бы отключить диалоговое окно «Предупреждение о конфиденциальности в элементах управления 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

1 Ответ

0 голосов
/ 26 января 2012

Если ваш диапазон данных в табеле непрерывен, вы можете заменить

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

Это предотвратит попадание пустых строк на ваш лист.

Если каждый табель не является непрерывным диапазоном, вы можете перемещаться по строкам в поисках пустых строк и их удаления.Дайте мне знать, если это так, и я обновлю свой ответ.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...