2017-01-04 3 views
0

Я получил следующий код на сайте Рона де Бруина, и он работает очень хорошо, чтобы вытащить данные в мастер-лист и обновить мастер-лист всякий раз, когда есть изменения в других листах.Слияние листов с ведущим листом

Но я хотел бы скопировать только определенные столбцы данных. Например, мои листы имеют данные от A:Z, но мне нужны только данные A:P на моем основном листе.

Любая помощь по этому вопросу будет принята с благодарностью и, пожалуйста, сообщите, что im не-кодер, поэтому, пожалуйста, укажите, что нужно изменить и где его изменить.

Sub CopyDataWithoutHeaders() 
Dim sh As Worksheet 
Dim DestSh As Worksheet 
Dim Last As Long 
Dim shLast As Long 
Dim CopyRng As Range 
Dim StartRow As Long 

With Application 
    .ScreenUpdating = False 
    .EnableEvents = False 
End With 

'Delete the sheet "Master Sheet" if it exist 
Application.DisplayAlerts = False 
On Error Resume Next 
ActiveWorkbook.Worksheets("Master Sheet").Delete 
On Error GoTo 0 
Application.DisplayAlerts = True 

'Add a worksheet with the name "Master Sheet" 
Set DestSh = ActiveWorkbook.Worksheets.Add 
DestSh.Name = "Master Sheet" 

'Fill in the start row 
StartRow = 2 

'loop through all worksheets and copy the data to the DestSh 
For Each sh In ActiveWorkbook.Worksheets 
    If sh.Name <> DestSh.Name Then 
    'Copy header row, change the range if you use more columns 
If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then 
    sh.Range("A1:Z1").Copy DestSh.Range("A1") 
End If 

     'Find the last row with data on the DestSh and sh 
     Last = LastRow(DestSh) 
     shLast = LastRow(sh) 

     'If sh is not empty and if the last row >= StartRow copy the CopyRng 
     If shLast > 0 And shLast >= StartRow Then 

      'Set the range that you want to copy 
      Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast)) 
      'Test if there enough rows in the DestSh to copy all the data 
      If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then 
       MsgBox "There are not enough rows in the Destsh" 
       GoTo ExitTheSub 
      End If 

      'This example copies values/formats, if you only want to copy the 
      'values or want to copy everything look below example 1 on this page 
      CopyRng.Copy 
      With DestSh.Cells(Last + 1, "A") 
       .PasteSpecial xlPasteValues 
       .PasteSpecial xlPasteFormats 
       Application.CutCopyMode = False 
      End With 

     End If 

    End If 
Next 

ExitTheSub: 

Application.Goto DestSh.Cells(1) 

'AutoFit the column width in the DestSh sheet 
DestSh.Columns.AutoFit 

With Application 
    .ScreenUpdating = True 
    .EnableEvents = True 
    End With 
End Sub 
Function LastRow(sh As Worksheet) 
    On Error Resume Next 
    LastRow = sh.Cells.Find(What:="*", _ 
          After:=sh.Range("A1"), _ 
          Lookat:=xlPart, _ 
          LookIn:=xlFormulas, _ 
          SearchOrder:=xlByRows, _ 
          SearchDirection:=xlPrevious, _ 
          MatchCase:=False).Row 
    On Error GoTo 0 
End Function 


Function LastCol(sh As Worksheet) 
    On Error Resume Next 
    LastCol = sh.Cells.Find(What:="*", _ 
          After:=sh.Range("A1"), _ 
          Lookat:=xlPart, _ 
          LookIn:=xlFormulas, _ 
          SearchOrder:=xlByColumns, _ 
          SearchDirection:=xlPrevious, _ 
          MatchCase:=False).Column 
    On Error GoTo 0 
End Function 

ответ

1

На самом деле вам просто нужно изменить код, определяющий область, которую необходимо скопировать. В вашем случае вы должны проверить «диапазоны» перед копированием данных:

sh.Range("A1:Z1").Copy DestSh.Range("A1") 

Эта линия берет на себя заголовки, так что вы можете заменить Z1 с е. г. P1.

Следующий диапазон для копирования данных:

Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast)) 

Здесь вы можете использовать существующие функциональные возможности, чтобы получить правильную начальную строку и последнюю строку. Но вместо того, чтобы выбирать полные строки, которые вы просто выбрать часть листа:

sh.Range("A" & StartRow & ":P" & shLast) 

Это должно сделать трюк.

P. S. Even Если вы не программист. Взгляните на основы VBA, это не так сложно, и вы можете делать много классных вещей, если знаете, как это работает ... :)

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