2017-01-04 2 views
0

Ron de Bruinのサイトから次のコードを取得しました。マスターシートにデータをプルし、他のシートに変更があるたびにマスタシートを更新するのにはかなりうまく機能します。マスターシートにシートをマージする

しかし、データの特定の列だけをコピーしたいと思います。たとえば、私のシートにはA:Zのデータがありますが、私はマスターシートにA:Pのデータしか必要としません。

これに関するお手伝いをさせていただきますようお願い申し上げます。私は非コーダーなので、具体的に何を変更するのか、どこで変更するのかをご確認ください。

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

実際には、コピーする領域を定義するコードを変更するだけで済みます。あなたのケースでは、データをコピーする前に、「範囲」をチェックする必要があります:あなたは電子とZ1を交換できるように

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

その行は、見出しの世話をします。 g。 P1。ここで

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

正しい開始行と最後の行を取得するために、既存の機能を使用することができます。

次の範囲は、データをコピーすることです。しかし、完全な行を選択するのではなく、シートの一部を選択するだけです。

これはすべきことです。

P. S.あなたがプログラマーでない場合でも。あなたがそれがどのように動作するかを知っていれば、VBAの基本を見て、それほど難しくなく、たくさんのクールなものをやることができます:

関連する問題