ソースブックの多くのワークシートの特定の範囲の値をコピー先のワークブックの多くのワークシートの同じ範囲にコピーする

Question

詳細を提供するためにこの記事を編集しています。

これは、元のブックの複数のワークシート（約90）の特定の範囲の値を、宛先ブックの多くのワークシートの同じ特定の範囲にコピーしようとするものです。ソースブックと宛先ブックの両方のワークシートには、同じ名前が付けられています。例えば

は、「N」による名「A」とのワークシートのため、アルゴリズムのようなものかもしれない：私だけにしようとすると、エラーが発生している

Copy from SourceWorkbook.Worksheet("A").Range ("H46:H85") 
PasteValues to DestinationWorkbook.Worksheet("A").Range ("H46:H85") 
. 
. 
. 
Copy from SourceWorkbook.Worksheet("N").Range ("H46:H85") 
PasteValues to DestinationWorkbook.Worksheet("N").Range ("H46:H85") 

名WS先がある場合は貼り付けが発生することができますソースws名と同じです。

これはこれまで私が行ってきたことです。

Sub TestGetReview_5() 

'still not working 

Dim ToWb As Workbook 
Dim FromWb As Workbook 

Dim FromSht As Worksheet 
Dim ToSht As Worksheet 
Dim SheetName As String 'not sure this is needed 

Set FromWb = Workbooks("SourceWorkbook.xlsm") 'wb is open 
Set ToWb = Workbooks("DestinationWorkbook.xlsm") 'wb is open 

For Each FromSht In FromWb.Worksheets 
If FromSht.Name Like "N*" And FromSht.Name <> "Notes" Then 

SheetName = FromSht.Name 
FromWb.Activate 
FromSht.Activate 
Range("H46:H85").Copy 
ToWb.Activate 
Set ToWb.ToSht.Sheets(SheetName) = FromWb.FromSht.Sheets(SheetName) 'Attempt to only allow pasting if Destination worksheet name is same as source worksheet name produces error "object doesn't support this property or method". Variable SheetName is correctly set to first ws in source wb 
ToSht.Activate 
Range("H46:H85").PasteSpecial Paste:=xlPasteValues, _ 
     Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

End If 
Next FromSht 

End Sub 

本当に助けていただきありがとうございます！

Answer 1

エラーの直接の原因は、FromWbがExcelブックを表すWorkbookオブジェクトを参照していることです。 WorkbookオブジェクトはFromShtという名前のプロパティやメソッドを持っていないので、この式は失敗します。

FromWb.FromSht 

---

あなたはSet声明、悪用されているように見える：

がへのオブジェクト参照を代入し変数またはプロパティ

これは、名前の等価性または類似性を強制しません。 Option Explicitはそれが必要、その後、あなたのモジュールの最上部に表示されない場合

If FromSht.Name = ToSht.Name Then 
    'do something here 
End If 

---

：そのためには、比較のいくつかの種類を確認する必要があります。

Option Explicitは、変数を使用する前に変数を宣言しなければならず、スペルミスや誤って宣言された変数のキャッチに役立ちます。

---

我々は存在しないワークシートにアクセスしようとすると、私たちはエラーが発生します。物事を単純化するために、ワークブックと名前を取る関数を書くことができます。そして、その名前でワークシートにうまくいくことができれば、そのワークシートを返します。それ以外の場合、関数はNothingを返します。つまり、ワークシートを参照しません。

Function SafeGetWorksheet(book As Workbook, name As String) As Worksheet 
    On Error GoTo ErrorHandler 
    Set SafeGetWorksheet = book.Sheets(name) 
    Exit Function 

ErrorHandler: 
End Function 

次に、コードは次のように書くことができる：

Dim source As Workbook 
Set source = Workbooks("SourceWorkbook.xlsm") 'wb is open 

Dim destination As Workbook 
Set destination = Workbooks("DestinationWorkbook.xlsm") 'wb is open 

Dim sheet As Worksheet 
'The following For Each will iterate through all the sheets in the source workbook 
'You may want to limit the source sheets somehow, as in S.Meaden's answer 
For Each sheet In source.Sheets 
    Dim destinationSheet As Worksheet 
    Set destinationSheet = SafeGetWorksheet(destination,sheet.Name) 

    'If there is a worksheet with the same name in the destination 
    If Not destinationSheet Is Nothing Then 
     'copy the cells from the source sheet's range to the destination sheet's range 
     destinationSheet.Range("H46:H85").Value = sheet.Range("H46:H85").Value 
    End If 
Next 

---

VBA References：

• Set statement
• If..Then
• Option Explicit statement
• On Error statement
• For Each statement

Excel object model reference：

• Workbook object
• Worksheet object
• Returning an object from a collection

Answer 2

大量のゲッターとセッターの両方の.Value2を使用して、魔法のコード行が必要です。

が、これは

Option Explicit 

Sub Test() 

    Dim lLoop As Long 
    For lLoop = Asc("A") To Asc("N") 
     DestinationWorkbook.Worksheet(Chr(lLoop)).Range("H46:H85").Value2 = SourceWorkbook.Worksheet(Chr(lLoop)).Range("H46:H85").Value2 
    Next 
End Sub 

Answer 3

だから、あなたは右、別のシートに同じ行に1枚の用紙にそれぞれの行からコピーして貼り付ける試してみてください。

For Each Cell In Sheets("Sheet1").Range("J1:J" & LastRow1) 
    If Cell.Value = "x" Or Cell.Value = "X" Then 
     matchRow = Cell.Row 
     Rows(matchRow & ":" & matchRow).Select 
     Selection.Copy 
     Sheets("Sheet2").Select 
     ActiveSheet.Rows(matchRow).Select 
     Selection.PasteSpecial 
     Sheets("Sheet1").Select 
    End If 
Next 

私はColumnJで「X」はありますと仮定していますが、これはあなたがコピー/貼り付けを行う必要があると言うの基準、またはフラグ、です。