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

自动过滤器很好，它们允许您逐行循环，但这意味着您不能在数据中有空行。 如果存在，请在删除空白之前对数据进行排序。