Question

我有2个工作表，我需要使用我每周收到的另一个工作表中的数据进行更新。我想知道它是否有可能使用我需要更新的2个工作表将数据复制到excel文件中，然后运行一个宏，选择我需要输出到其他工作表的单元格。我不知道自己是否足够清楚，下面就是一个例子。

例如我有以下表格，我需要查看＆＃34; name＆＃34;列，如果名称以＆＃34; sony＆＃34;开头，请将我需要的单元格复制到索尼工作表中，如果它从三星开始复制我需要的单元格到三星表等等。

我想复制整行然后删除我不需要的列也行。

主要工作表示例

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.对于每个额外的电视，您需要为每个值添加以下内容：

Dim NewTVWrkBk As Workbook'声明新的电视工作簿
Dim NewTVSheet As Worksheet'声明新的电视工作表
Set NewTVWrkBk = Workbooks.Open("C:\New TV.xls")打开工作簿
Set NewTVSheet = NewTVWrkBk.Sheets(1)'打开第一个工作表（如果您要存储数据的那个
NewTVCounter =2'设置了新的电视柜台
Case "New TV" NewTVSheet.Range("A" & NewTVCounter, "E" & NewTVCounter).Value = ActiveSheet.Range("A" & counter, "E" & counter).Value NewTVCounter = NewTVCounter + 1'添加新的案例陈述
NewTVWrkBk.Close True'关闭工作簿并保存更改
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

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

Excel宏，根据另一个单元格值复制和粘贴多个单元格？

2 个答案: