2016-11-29 4 views
0

У меня есть книга Excel с несколькими листами, содержащими данные, но их заголовки столбцов находятся не в одном порядке. У меня также есть лист под названием «Шаблон», который содержит имена столбцов, и мне нужно объединить все листы и привести их в шаблон.Таблицы заголовков столбцов и таблицы слияния

Ex- 
Sheet 1 = Name DOB Age 
      Sam 1/2 22 
      Pat 22/6 25 
Sheet 2 = DOB Age Name 
      5/6 21 Peter 
Sheet 3 = Name 
      Ben 
Sheet 4 = Age 
      27/9 

Template = Name Age DOB 
      Sam 22 1/2 
      Pat 25 22/6 
      Peter 21 5/6 
      Ben 0 0 
      0  0 27/9 

так Шаблон должен объединить один под другим все данные из рабочих листов, оставьте 0, где столбец не присутствует в соответствующем листе.

Приведенный ниже код делает это правильно для 1 листа, но когда я создаю внешний вид для включения всех листов, он записывает данные.

Sub CopyHeaders() 
    Dim header As Range, headers As Range 
    Dim ws2 As Worksheet 
    Dim Template As Worksheet 
    Dim cell As Range 
    For Each ws2 In ActiveWorkbook.Worksheets 
    If IsError(Application.Match(ws2.Name, _ 
    Array("Template", "Sheet1"), 0)) Then 
    Set Rng = ws2.UsedRange 
    For Each cell In Rng 
     If cell.Value = "" Then cell.Value = "0" 

    Next 
    Set headers = ws2.Range("A1:Z1") 
    For Each header In headers 
     If GetHeaderColumn(header.Value) > 0 Then 
     Range(header.Offset(1, 0), header.End(xlDown)).Copy Destination:=Worksheets("Template").Cells(2, GetHeaderColumn(header.Value)).End(xlDown).End(xlUp).Offset(1, 0) 
     End If 
    Next 
    End If 
    Next 
End Sub 
Function GetHeaderColumn(header As String) As Integer 
    Dim headers As Range 
    Set headers = Worksheets("Template").Range("A1:Z1") 
    GetHeaderColumn = IIf(IsNumeric(Application.Match(header, headers, 0)), Application.Match(header, headers, 0), 0) 
End Function 

Моя ошибка особенно в

Range(header.Offset(1, 0), header.End(xlDown)).Copy Destination:=Worksheets("Template").Cells(2, GetHeaderColumn(header.Value)).End(xlDown).End(xlUp).Offset(1, 0) 

Нужна помощь, пожалуйста!

+0

Вам нужно найти последнюю использованную строку, а не последнюю ячейку в столбце, так как в другой колонке может быть информация ниже. Эти данные затем будут перезаписаны. – Tragamor

ответ

0

Вы должны изменить 2 в Cells(2, GetHeaderColumn(header.Value)) в строку, вызвавшую к чему-то большому, потенциально Worksheets("Template").Rows.Count (что означает, что вы можете также удалить .End(xlDown)).

.End(xlDown).End(xlUp), который у вас есть в данный момент, находит нижнюю часть смежного диапазона, если вы уже находитесь внизу (как в случае с первой копией), но находит верх, если вы находитесь где-нибудь еще в диапазоне (как строка 2 будет для любой последующей копии), таким образом, вы начнете перезаписывать.

+0

Не работает, когда я изменил его на - Диапазон (header.Offset (1, 0), header.End (xlDown)). Копировать Назначение: = Рабочие листы («Шаблон»). Ячейки (Листы («Шаблон»). Rows.Count, GetHeaderColumn (header.Value)) –

+0

Я создал функцию LastRow и заменил ее, она сработала! –

+0

Рад это слышать. Если вы хотите сохранить его в коде, то строка, в которой вы нуждаетесь, - это диапазон (header.Offset (1, 0), header.End (xlDown)). Copy Destination: = Worksheets («Template»). («Шаблон»). Rows.Count, GetHeaderColumn (header.Value)). End (xlUp) .Offset (1, 0) '. – bobajob

Смежные вопросы