Макрос Excel, чтобы скопировать и вставить несколько ячеек на основе другого значения ячейки?

Question

У меня есть 2 рабочих листа, мне нужно обновлять данные из другого рабочего листа, который я получаю каждую неделю.Интересно, возможно ли скопировать данные в файл excel с двумя рабочими листами, которые мне нужно обновить, а затем запустить макрос, который выбирает ячейки, которые мне нужно вывести на другие листы.Я не знаю, достаточно ли я ясен, ниже приведен пример.

Например, у меня есть следующий лист, мне нужно просмотреть столбец «name» и, если имя начинается с «sony», скопировать нужные ячейки на лист sony, если он начинается с копии Samsungячейки, которые мне нужны, на листе 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

Я бы использовал AUTOFILTER для столбца A, чтобы получить только те строки, которые я хочу видеть, тогда мы можем скопировать только те столбцы, которые нам нужны.В этом примере shtARR используется как для имен листов, так и для фильтра, поэтому сопоставьте имена целевых листов, Sony, Samsung, Hitachi и т. Д. Затем попробуйте это:позволяет вам избегать циклических построчно, но это означает, что вы не можете иметь пустые строки в данных.Сортируйте данные перед удалением пробелов, если они есть.

Answer 2

вы можете попробовать код ниже. запустите его на листе, который вы получите

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 'добавить новую инструкцию case
7. NewTVWrkBk.Close True 'Закрыть рабочую книгу и сохранить изменения
8. Set NewTVWrkBk = Nothing 'добавить также эту строку

этот код перезапишет существующий код в ваших sonytv и т. Д. Книгах ... вы не объяснили, хотели вы этого или нет. так что я предположил.