Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
info mtg criteria from one wkbk to another
I need to extract select information from one workbook into another workbook
if the contents of one cell matches 1 of 4 numbers. It does not need to be in the same order (col2 comes before col1 in the destination wkbk) so a simple copy and paste is not the best answer. wkbk1 col 1 col 2 col3 col4 col5 col6 col7 etc...... empid dept# ann sal. hire date title address name 123 535 22000 1/2/90 txt 122 726 30000 12/16/09 txt 178 513 25000 2/10/02 txt 552 810 42000 6/7/08 txt Destination wkbk name doh dept# ann sal I only need it copied over if the dept# is equal to 513,535,540, or 560 and only certain columns. Any suggestions would be greatly appreciated. |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
info mtg criteria from one wkbk to another
Interesting problem... Some VBA would solve it nicely. I assumed the
following: 1. The source data is laid out like you had in your example, on a sheet called Source 2. A1:G1 on source are column headings and the data is in A2:Gxxx 3. You want to copy to a sheet called Destination. 4. A1:D1 on Destination are headers and the data you need will be in A2:Dxxx 5. You have a list of the departments that you'd like to copy over in range G1:Gxxx where G1 is actually a header row ("Depts Needed" or something like that). This will give you the flexibility to copy 1, 2, 3, or 17 depts over to Destination. If you have it set up like that, this code should work: Sub Copydata() Dim rngCell, rngDept, rngDepts, rngSource As Range Sheets("Source").Select Set rngSource = Range("B2:B" & Range("B1").End(xlDown).Row) Sheets("Destination").Select Set rngDepts = Range("G2:G" & Range("G1").End(xlDown).Row) ' Select and clear the destination range Range("A2").Select Range("A2:D5000").ClearContents ' Now walk down the source range For Each rngCell In rngSource For Each rngDept In rngDepts If rngDept = rngCell Then bFound = True Next ' If we had a hit, then... If bFound = True Then ' copy all of the data ActiveCell = rngCell.Offset(0, 5) ActiveCell.Offset(0, 1) = rngCell.Offset(0, 2) ActiveCell.Offset(0, 2) = rngCell ActiveCell.Offset(0, 3) = rngCell.Offset(0, 1) ' Move to the next destination cell ActiveCell.Offset(1, 0).Select bFound = False End If Next End Sub -- Happy calculating! If you like this answer, please click ''Yes.'' "bkinman" wrote: I need to extract select information from one workbook into another workbook if the contents of one cell matches 1 of 4 numbers. It does not need to be in the same order (col2 comes before col1 in the destination wkbk) so a simple copy and paste is not the best answer. wkbk1 col 1 col 2 col3 col4 col5 col6 col7 etc...... empid dept# ann sal. hire date title address name 123 535 22000 1/2/90 txt 122 726 30000 12/16/09 txt 178 513 25000 2/10/02 txt 552 810 42000 6/7/08 txt Destination wkbk name doh dept# ann sal I only need it copied over if the dept# is equal to 513,535,540, or 560 and only certain columns. Any suggestions would be greatly appreciated. |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
info mtg criteria from one wkbk to another
Try following code. Place a command button on the sheet from the control box Code: -------------------- Private Sub CommandButton1_Click() Dim row1 As Integer, col1 As Integer Dim row2 As Integer, col2 As Integer row1 = 1 col1 = 1 row2 = 1 col2 = 1 While Workbooks(1).Sheets(1).Cells(row, col).Value < "" If (Workbooks(1).Sheets(1).Cells(row1, col1 + 1).Value = "513" Or Workbooks(1).Sheets(1).Cells(row1, col1 + 1).Value = "535" Or Workbooks(1).Sheets(1).Cells(row1, col1 + 1).Value = 540 Or Workbooks(1).Sheets(1).Cells(row1, col1 + 1).Value = "560") Then Workbooks(2).Sheets(1).Cells(row2, col2).Value = Workbooks(1).Sheets(1).Cells(row1, col1).Value Workbooks(2).Sheets(1).Cells(row2, col2 + 1).Value = Workbooks(1).Sheets(1).Cells(row1, col1 + 1).Value Workbooks(2).Sheets(1).Cells(row2, col2 + 2).Value = Workbooks(1).Sheets(1).Cells(row1, col1 + 2).Value Workbooks(2).Sheets(1).Cells(row2, col2 + 3).Value = Workbooks(1).Sheets(1).Cells(row1, col1 + 3).Value Workbooks(2).Sheets(1).Cells(row2, col2 + 4).Value = Workbooks(1).Sheets(1).Cells(row1, col1 + 4).Value Workbooks(2).Sheets(1).Cells(row2, col2 + 5).Value = Workbooks(1).Sheets(1).Cells(row1, col1 + 5).Value Workbooks(2).Sheets(1).Cells(row2, col2 + 6).Value = Workbooks(1).Sheets(1).Cells(row1, col1 + 6).Value Workbooks(2).Sheets(1).Cells(row2, col2 + 7).Value = Workbooks(1).Sheets(1).Cells(row1, col1 + 7).Value row2=row2+1 End If row1 = row1 + 1 Wend End Sub -------------------- Hope this helps -- Chris Bode |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Pull info from separate worksheet based on given criteria | Excel Discussion (Misc queries) | |||
Return info based on 1 criteria | Excel Discussion (Misc queries) | |||
Pulling info from other spreadsheets based on a set of criteria... | Excel Worksheet Functions | |||
List info if criteria is met? | Excel Worksheet Functions | |||
Setting formula to give info from rows with certain criteria | Excel Worksheet Functions |