別のセルの値に基づいて複数のセルをコピーして貼り付けるExcelマクロ？

Question

私は2枚のワークシートを持っています。私は毎週受け取る別のワークシートのデータで更新する必要があります。可能であれば、 は、更新が必要な2つのワークシートでExcelファイルにデータをコピーし、他のワークシートに出力する必要があるセルを選択するマクロを実行するのだろうかと思います。 私は十分に明確であるかどうかわかりませんが、以下は例です。

たとえば、「名前」列を見て、名前が「ソニー」で始まる場合は、ソニーのワークシートに必要なセルをコピーします.Samsungで始まる場合はセルをコピーします私は三星シートなどが必要です。

私は、行全体をコピーし、必要のない列を削除しても問題ないと思います。

メインシートの例

 
Name   --- Type --- Extra --- Year --- Power 
Sony TV   --- LCD --- CAM --- 2009 --- 90W
 
Samsung TV  --- LED --- WIFI --- 2010 --- 70W 
Sony TV   --- LCD --- SAT --- 2011 --- 90W 
Hitachi TV  --- LED --- CAM --- 2012 --- 70W
 

Sony Sheet Example 
Name --- Type --- Year --- Power
 

Samsung sheet Example 
Name --- Type --- Year --- Power

Answer 1

列AにAUTOFILTERを使用して、表示したい行だけを取得したい場合は、必要な列だけをコピーできます。この例では、shtARRがsheetnamesとフィルタの両方に使用するので、など、あなたの対象シート名が一致し、ソニー、サムスン、日立、作成された後、これを試してみてください。

Sub VendorFilters() 
Dim ws2 As Worksheet, LR As Long 
Dim shtARR As Variant, i As Long 

'assuming these are the names of the target sheets, we can use for filtering, too 
shtARR = Array("Sony", "Samsung", "Hitachi") 

With Sheets("Main")     'filtering the sheet with the original data 
    .AutoFilterMode = False   'turn off any prior filters 
    .Rows(1).AutoFilter    'new filter 

    For i = LBound(shtARR) To UBound(shtARR) 
     Set ws2 = Sheets(shtARR(i))   'if you get an error here, check the sheet names 

     .Rows(1).AutoFilter 1, shtARR(i) & "*"   'new filter for current value 
     LR = .Range("A" & .Rows.Count).End(xlUp).Row 'last row with visible data 

     If LR > 1 Then     'if any rows visible, copy wanted columns to sheet2 
      .Range("A2:A" & LR).Copy ws2.Range("A1") 
      .Range("C2:D" & LR).Copy ws2.Range("B1") 
     End If 
    Next i 

    .AutoFilterMode = False    'remove the filter 
End With 

End Sub 

オートフィルタいいです、彼らはあなたを許します行ごとにループを回避するには、データ内に空白の行を入れることはできません。ブランクを削除する前にデータをソートします（存在する場合）。

Answer 2

あなたは以下のコードを試すことができます。あなたはコードがそれぞれ余分なテレビの列AからEにあなたのデータシートからすべての値をコピーします、あなたはそれぞれのために以下を追加する必要があります

Public Sub CopyDataFromDataWorkBook() 
Dim counter As Integer 
Dim SonyWrkBk As Workbook 
Dim SamsungWrkBk As Workbook 
Dim SonySheet As Worksheet 'declare sonysheet and samsung (add more if you need) 
Dim SamsungSheet As Worksheet 
Dim datasheet As Worksheet 
    '****Variables 
    Set datasheet = ActiveSheet 
    Set SonyWrkBk = Workbooks.Open("C:\Sony TV.xls") 'opens up workbook stored at C:\ (Addmore if you need) 
    Set SamsungWrkBk = Workbooks.Open("C:\Samsung TV.xls") 

    Set SonySheet = SonyWrkBk.Sheets(1) 'opens up the worksheet we are working on, in this case the first worksheet 
    Set SamsungSheet = SamsungWrkBk.Sheets(1) 

    last = datasheet.Cells(Rows.Count, "A").End(xlUp).row 'on your data sheet, we can find the last row by using ColA 
    counter = 2 
    SonyCounter = 2 'this is to determine how far down are we in the sony file 
    SamsungCounter = 2 
    '*** 
    For i = last To 2 Step -1 
     Select Case datasheet.Range("A" & counter).Value 
     Case "Sony TV" 
      SonySheet.Range("A" & SonyCounter, "E" & SonyCounter).Value = ActiveSheet.Range("A" & counter, "E" & counter).Value 
      SonyCounter = SonyCounter + 1 
     Case "Samsung TV" 
      SamsungSheet.Range("A" & SamsungCounter, "E" & SamsungCounter).Value = ActiveSheet.Range("A" & counter, "E" & counter).Value 
      SamsungCounter = SamsungCounter + 1 
     End Select 
     counter = counter + 1 
    Next i 
SonyWrkBk.Close True 'the true bit will save the workbook 
SamsungWrkBk.Close True 'if you set to false or nothing, you will be asked everytime if you wana save changes 
Set SamsungWrkBk = Nothing 
Set SonyWrkBk = Nothing 'needed to free up memory 
End Sub 

を受け取るデータシート上でそれを実行します。

1. Dim NewTVWrkBk As Workbook
2. Set NewTVWrkBk = Workbooks.Open("C:\New TV.xls")ワークブック
3. を開き、新しいテレビのワークシートを宣言「新しいテレビワークブックに
4. Dim NewTVSheet As Worksheetを宣言」 「
5. NewTVWrkBk.Close True新しいcaseステートメントを追加」ワークブックを閉じ、保存
を変更
6. Case "New TV" NewTVSheet.Range("A" & NewTVCounter, "E" & NewTVCounter).Value = ActiveSheet.Range("A" & counter, "E" & counter).Value NewTVCounter = NewTVCounter + 1新しいテレビカウンタを設定は「あなたがデータを格納したいのthats
7. NewTVCounter =2があれば（最初のワークシートを開きます」
8. Set NewTVWrkBk = Nothingは、「あなたがそれを望んでいたかいない場合は、説明didntの...だけでなく

このコードは、あなたsonytvなどのワークブック内の既存のコードを上書きします。この行を追加します。だから私は思った。