Excel macro, to copy and paste a multiple cells based on another cell value?

Question

I have 2 worksheets, I need to update with data from another worksheet I receive every week. I wonder if its possible to copy the data into the excel file with the 2 worksheets I need updating and then run a macro that selects the cells i need to output to the other worksheets. I don't know if i am being clear enough, below is an example.

For example I have the following sheet, I need to look though the "name" column and if the name begins with "sony", copy the cells i need to the sony worksheet, if it begins with Samsung copy the cells i need to the Samsung sheet and so on.

I suppose that copying the whole row then deleting the columns I don't need will also work.

Main Sheet Example

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

I would use an AUTOFILTER on column A to get just the rows I want visible, then we can copy just the columns we want. In this example, the shtARR is used for both the sheetnames and the filter, so make your target sheet names match, Sony, Samsung, Hitachi, etc. Then try this:

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

Autofilters are nice, they allow you to avoid looping row by row, but it means you can't have blank rows in the data. Sort the data before to remove the blanks, if present.

Answer 2

you can try the code below. run it on the Datasheet you receive

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

The code will copy all values from your data sheet from Column A to E. For each extra TV, you need to add the following for each:

1. Dim NewTVWrkBk As Workbook 'declare the new tv workbook
2. Dim NewTVSheet As Worksheet 'declare the new tv worksheet
3. Set NewTVWrkBk = Workbooks.Open("C:\New TV.xls") open the workbook
4. Set NewTVSheet = NewTVWrkBk.Sheets(1) 'open the first worksheet (if thats where you want to store the data
5. NewTVCounter =2 'set up the new tv counter
6. Case "New TV" NewTVSheet.Range("A" & NewTVCounter, "E" & NewTVCounter).Value = ActiveSheet.Range("A" & counter, "E" & counter).Value NewTVCounter = NewTVCounter + 1 'add a new case statement
7. NewTVWrkBk.Close True 'Close the workbook and Save changes
8. Set NewTVWrkBk = Nothing 'add this line as well

this code will overwrite existing code in you sonytv etc workbooks... you didnt explain if you wanted that or not. so i assumed.