Скопируйте и вставьте не пустые ячейки из определенного диапазона - PullRequest
0 голосов
/ 25 апреля 2019

У меня никогда не было скриптов VBA или макросов.

Однако мне нужно скопировать множество документов Excel в один.Поэтому мне было интересно, как я могу реализовать следующее (или в каком направлении направиться):

Мне нужно скопировать таблицу из x строк и y столбцов, но есть много пустых строк.И много строк объединены.Мне нужно скопировать это в другой файл, объединить строки и скопировать содержимое во все объединенные столбцы.

Существует несколько таких файлов, которые нужно поместить в один файл.Каждый файл имеет различное количество листов.

Если что-нибудь еще есть, я могу просто создать макрос, чтобы копировать и вставлять только непустые столбцы, объединять объединенные столбцы и иметь одинаковые данные между всеми объединенными строками?

1 Ответ

0 голосов
/ 25 апреля 2019

Это частичный ответ, который не касается обработки отдельных листов.Это дает вам основу для начала.

Sub Process_Workbooks()
'Process a Collection of workbooks
Dim arrPathandFile, FilePointer As Long
Dim strPathAndFile As String
Dim bkSource As Workbook, shInput As Worksheet
Dim bkDestination As Workbook, shResult As Worksheet
Dim myPath, PathandFile As String

arrPathandFile = Application.GetOpenFilename("Audit Files (*.xls*), *.xlsx, All Files (*.*), *.*", , "Select Workbooks to process", "", True)
' user cancels file selection
If Not IsArray(arrPathandFile) Then Exit Sub

'Create a place to put the results
Set bkDestination = Workbooks.Add

'For each file in the collectin
For FilePointer = 1 To UBound(arrPathandFile)
    strPathAndFile = arrPathandFile(FilePointer)

    'Open the workbook
    Set bkSource = Workbooks.Open(strPathAndFile)

    'process each worksheet
    For Each shInput In bkSource.Sheets
        Set shResult = bkDestination.Sheets.Add
        shResult.Name = shInput.Name & "(" & FilePointer & ")"

        'figure out the source range to copy
        shInput.Range("A1:Z900").Copy Destination:=shResult.Range("A1")

        'now do stuff to the sheet in the destination.
        Call Do_Stuff_To_sheets(shInput)

    'repeat for each sheet in the workbook
    Next shInput
    bkSource.Close
'repeat for each workbook selected
Next FilePointer

'save the results
bkDestination.SaveAs myPath & "NewFilename.xlsx"
End Sub

Private Sub Do_Stuff_To_sheets(mySheet As Worksheet)
'process each sheet to unmerge and defrag columns

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