Excel宏，根據另一個單元格值復制和粘貼多個單元格？

Question

我有2個工作表，我需要使用我每周收到的另一個工作表中的數據進行更新。 我想知道是否可以使用我需要更新的2個工作表將數據復制到excel文件中，然后運行一個宏來選擇我需要輸出到其他工作表的單元格。 我不知道我是否足夠清楚，下面是一個例子。

例如，我有以下表格，我需要查看“名稱”列，如果名稱以“索尼”開頭，請將我需要的單元格復制到索尼工作表，如果它從三星開始復制我需要的單元格三星表等。

我想復制整行然后刪除我不需要的列也會起作用。

主表示例

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

你可以嘗試下面的代碼。 在您收到的數據表上運行它

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

代碼會將數據表中的所有值從A列復制到E.對於每個額外的電視，您需要為每個值添加以下內容：

1. Dim NewTVWrkBk As Workbook '宣布新的電視工作簿
2. Dim NewTVSheet As Worksheet '宣布新的電視工作表
3. Set NewTVWrkBk = Workbooks.Open("C:\\New TV.xls")打開工作簿
4. Set NewTVSheet = NewTVWrkBk.Sheets(1) '打開第一個工作表（如果你要存儲數據的那個）
5. NewTVCounter =2 '設置了新的電視櫃台
6. Case "New TV" NewTVSheet.Range("A" & NewTVCounter, "E" & NewTVCounter).Value = ActiveSheet.Range("A" & counter, "E" & counter).Value NewTVCounter = NewTVCounter + 1 '添加一個新案例陳述
7. NewTVWrkBk.Close True '關閉工作簿並保存更改
8. Set NewTVWrkBk = Nothing '也添加此行

這段代碼將覆蓋你sonytv等工作簿中的現有代碼...你沒有解釋你是否想要這樣做。 所以我假設了。

Answer 2

我會在A列上使用AUTOFILTER來獲取我想要的行，然后我們可以只復制我們想要的列。 在此示例中，shtARR用於工作表名稱和過濾器，因此要使目標工作表名稱匹配，索尼，三星，日立等。然后嘗試這樣：

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

自動過濾器很好，它們允許您逐行循環，但這意味着您不能在數據中有空行。 如果存在，請在刪除空白之前對數據進行排序。