個別の列見出しを使用して複数のシートをマスターシートにコピーする方法

Question

初めての投稿者が長い時間ユーザー！あなたはギャップを埋めるのを助けることができると願っています！

複数のシートを1つのマスターシートにまとめて列ヘッダーを一致させるためにvbaを作成しようとしています。私は複数のスレッドとMicrosoftからのドキュメントを見つけましたが、まだまだ近づいています。私は他のユーザーからたくさんのものを手に入れ、必要なものを追加しました。

Set DestSheet = Sheet("Database_Headers") 

が、私はさらに明確にする必要がいた場合や、私はさらに明確化を追加する必要がある場合、私はわからない：ここでは私の現在のエラーから来ている...私が持っているもの

Option Compare Text 

Sub cc() 

    Dim Sheet As Worksheet 
    Dim DestSheet As Worksheet 
    Dim Last As Long 
    Dim SheetLast As Long 
    Dim CopyRange As Range 
    Dim StartRow As Long 

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

    Set DestSheet = Sheet("Database_Headers") 
    StartRow = 2 

    For Each Sheet In ActiveWorkbook.Worksheets 
     If LCase(Left(Sheet.Name, 6)) = "Demand" Then 

      Last = DestSheet.Cells(Rows.Count, "A").End(xlUp).Row 
      SheetLast = Sheet.Cells(Rows.Count, "A").End(xlUp).Row 

      If SheetLast > 0 And SheetLast >= StartRow Then 

       Sheet.Select 
       Region_Name = WorksheetFunction.Match("Region Name", Rows("1:1"), 0) 
       location_code = WorksheetFunction.Match("location_code", Rows("1:1"), 0) 
       location_name = WorksheetFunction.Match("location_name", Rows("1:1"), 0) 
       dealer_code = WorksheetFunction.Match("dealer_code", Rows("1:1"), 0) 

       Sheet.Columns(Region_Name).Copy Destination:=DestSheet.Range("C" & Last + 1) 
       Sheet.Columns(location_code).Copy Destination:=DestSheet.Range("D" & Last + 1) 
       Sheet.Columns(location_name).Copy Destination:=DestSheet.Range("E" & Last + 1) 
       Sheet.Columns(dealer_code).Copy Destination:=DestSheet.Range("F" & Last + 1) 

      End If 

     End If 

     CopyRange.Copy 

     With DestSheet.Cells(Last + 1, "C") 

     End With 

     DestSheet.Cells(Last + 1, "B").Resize(CopyRng.Rows.Count).Value = Sheet.Name 

    Next 

ExitTheSub: 

    Application.Goto DestSh.Cells(1) 

    With Application 
     .ScreenUpdating = True 
     .EnableEvents = True 
    End With 

End Sub 

ですライン。

ご協力いただきありがとうございます。

私はコードに更新したEDITのUPDATE

： オプションは、テキスト

サブCC（）

Dim Sh As Worksheet 
Dim DestSheet As Worksheet 
Dim Last As Long 
Dim SheetLast As Long 
'Dim CopyRange As Range 
Dim StartRow As Long 

'Disables screen updates so screen does not flicker when code is running 
With Application 
    .ScreenUpdating = False 
    .EnableEvents = False 
End With 

'Clarify the summary tab 
Set DestSheet = Worksheets("Database_Headers") 


    ' Will not copy column headers and will only copy data 
    StartRow = 2 

     'Will copy all data from each sheet that has a different name then the summary tab 
     For Each Sh In ActiveWorkbook.Worksheets 
     If LCase(Left(Sh.Name, 6)) = "Demand" Then 

      Last = DestSheet.Cells(Rows.Count, "B").End(xlUp).Row 
      shLast = Sh.Cells(Rows.Count, "A").End(xlUp).Row 

      If shLast > 0 And shLast >= StartRow Then 

      `Set CopyRange = Sh.Select` 
       Region_Name = WorksheetFunction.Match("Region Name", Rows("1:1"), 0) 
       location_code = WorksheetFunction.Match("location_code", Rows("1:1"), 0) 
       location_name = WorksheetFunction.Match("location_name", Rows("1:1"), 0) 
       dealer_code = WorksheetFunction.Match("dealer_code", Rows("1:1"), 0) 

       Sh.Columns(Region_Name).Copy Destination:=DestSheet.Range("B" & Last + 1) 
       Sh.Columns(location_code).Copy Destination:=DestSheet.Range("C" & Last + 1) 
       Sh.Columns(location_name).Copy Destination:=DestSheet.Range("D" & Last + 1) 
       Sh.Columns(dealer_code).Copy Destination:=DestSheet.Range("E" & Last + 1) 

      End If 

     End If 

    `CopyRange.Copy` 

    With DestSheet.Cells(Last + 1, "B") 
    End With 

    DestSheet.Cells(Last + 1, "A").Resize(CopyRange.Rows.Count).Value = Sh.Name 

Next

ExitTheSub:

を比較

Application.Goto DestSheet.Cells(1) 

' AutoFit the column width in the summary sheet. 
DestSheet.Columns.AutoFit 

With Application 
    .ScreenUpdating = True 
    .EnableEvents = True 
End With 

End Subの

私は私のコピー範囲の機能に関しては、別のエラーを見ています。私はVBAをシートにしたいと思うし、マスターにあるものと一致する列見出しの下にのみデータをコピーします。助けてくれてありがとう！！

Answer 1

それが役に立つかもしれませんあなたのエラーは、あなたが適切Sheetsコレクションを参照していないという事実です。あなたはWorksheetとしてDestSheetを宣言しているので、あなたが避けることができるので、この場合には、あなたは、Sheetsコレクションに、しかしWorksheetsコレクションに参照すべきではありません

Set DestSheet = Sheets("Database_Headers")

：このように行われるべきです後でいくつかの問題。したがって、このように： - 空のExcelを作成し、別シートとしてグラフシートを追加一般に

Set DestSheet = Worksheets("Database_Headers")

、これはWorsheetとSheet差（および対応するコレクション）です。その後、次のコードを実行します。

Public Sub TestMe() 
    Debug.Print Worksheets.Count 
    Debug.Print Sheets.Count 
End Sub 

それは3と4を与えるだろう - あなたは3つのエクセルのワークシートおよび4シートを持っている（グラフシートは、シートです）。ここで

は、あなたがそれを正しく使用すれば避けられる問題、である - VBA Refer to worksheet vs chart sheet

Answer 2

はい、コードを読み込んで同じエラーが発生しました。あなたは

Set DestSheet = Sheet("Database_Headers") 

を持っているので、それはですが、あなたはその後

Set DestSheet = Sheets("Database_Headers") 

を持っている必要がありますが、そのような

あなたは「シートを定義していない

For Each Sheet... 

などの他のエラーに対処する必要があります"変数として （" Sheet "以外のものは予約語で、おそらく" sh "です） ここから始めるにはいくつかのコードがあります。十分な情報がありませんでした実際にそれを完了するために、しかし、あなたは

Option Explicit 
Sub cc() 
Dim sh As Worksheet, destSh As Worksheet 
Dim s As String, r As Range, i As Integer, j As Integer 

Set destSh = Sheets("Database_Headers") 
Set destRange = destSh.Range("A1") 
For Each sh In Worksheets 
    If LCase(Left(Sheet.Name, 6)) = "Demand" Then 
    Set r = sh.Range("A1") 
    Set r = Range(r, r.End(xlDown)) 
    For i = 0 To r.Row.Count 
     s = r.Offset(i, 0).Value 
     If InStr(s, "desired text") Then 
     'transferedData = ... 
     End If 
    Next i 
    End If 
    'transfer data to destSh 
    destRange.Offset(j, 0) = transferedData 
    j = j + 1 
Next sh 

End Sub