Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Match Value in Range and Then Paste
Hi all, I am looking for macro which should do something (see below)
EXAMPLE : Sub test () set OldWbk = Workbooks("Main.xlsm") Workbooks.Open Filename:= "C:\My Document\" & OldWbk.Range("A1").Value & ".xlsm" ActiveWorkbook.Range("I2:J15").Copy OldWbk.Select If (any cell.value) in OldWbk.Range("D1:F1") = OldWbk.Range("A1").Value Then Select.Offset.(of that cell).Paste End Sub Above is just rough example that what I want macro to do. Basically I want macro to open workbook of which name is in Range("A1") and then copy data from that workbook and then come back to old workbook and look in each cell of Range("D1:F1") and if any cell have same value to Range("A1") then Paste data one cell below of that cell. Please can any friend help me on this |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Match Value in Range and Then Paste
Try this
Sub test() Set OldWbk = Workbooks("Main.xlsm") Set newbk = Workbooks.Open(Filename:= _ "C:\My Document\" & OldWbk.Range("A1").Value & ".xlsm") For Each cell In newbk.Range("I2:I15") Data = cell.Offset(0, 1) With OldWbk Set c = .Range("D1:F1").Find(what:=cell, _ LookIn:=xlValues, loookat:=xlWhole) If c Is Nothing Then MsgBox ("could not find : " & cell) Else LastRow = .Cells(Rows.Count, c.Column).End(xlUp).Row NewRow = LastRow + 1 .Cells(NewRow, c.Column) = Data End If End With Next cell End Sub "K" wrote: Hi all, I am looking for macro which should do something (see below) EXAMPLE : Sub test () set OldWbk = Workbooks("Main.xlsm") Workbooks.Open Filename:= "C:\My Document\" & OldWbk.Range("A1").Value & ".xlsm" ActiveWorkbook.Range("I2:J15").Copy OldWbk.Select If (any cell.value) in OldWbk.Range("D1:F1") = OldWbk.Range("A1").Value Then Select.Offset.(of that cell).Paste End Sub Above is just rough example that what I want macro to do. Basically I want macro to open workbook of which name is in Range("A1") and then copy data from that workbook and then come back to old workbook and look in each cell of Range("D1:F1") and if any cell have same value to Range("A1") then Paste data one cell below of that cell. Please can any friend help me on this |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Match Value in Range and Then Paste
On Sep 15, 1:32*pm, Joel wrote:
Try this Sub test() Set OldWbk = Workbooks("Main.xlsm") Set newbk = Workbooks.Open(Filename:= _ * * "C:\My Document\" & OldWbk.Range("A1").Value & ".xlsm") For Each cell In newbk.Range("I2:I15") * *Data = cell.Offset(0, 1) * *With OldWbk * * * Set c = .Range("D1:F1").Find(what:=cell, _ * * * * *LookIn:=xlValues, loookat:=xlWhole) * * * If c Is Nothing Then * * * * *MsgBox ("could not find : " & cell) * * * Else * * * * *LastRow = .Cells(Rows.Count, c.Column).End(xlUp).Row * * * * *NewRow = LastRow + 1 * * * * *.Cells(NewRow, c.Column) = Data * * * End If * *End With Next cell End Sub "K" wrote: Hi all, *I am looking for macro which should do something (see below) EXAMPLE : Sub test () set OldWbk = Workbooks("Main.xlsm") Workbooks.Open Filename:= "C:\My Document\" & OldWbk.Range("A1").Value & ".xlsm" ActiveWorkbook.Range("I2:J15").Copy OldWbk.Select If (any cell.value) in OldWbk.Range("D1:F1") = OldWbk.Range("A1").Value Then Select.Offset.(of that cell).Paste End Sub Above is just rough example that what I want macro to do. *Basically I want macro to open workbook of which name is in Range("A1") and then copy data from that workbook and then come back to old workbook and look in each cell of Range("D1:F1") and if any cell have same value to Range("A1") then Paste data one cell below of that cell. *Please can any friend help me on this- Hide quoted text - - Show quoted text - Hi joel, Thanks for replying. The actual macro on which I am working with is (see below) Sub import() Set src = Workbooks("Book5.xlsm").Sheets("Sheet1") If src.Range("D20").Value < "" Then Workbooks.Open Filename:= _ C:\My Document\2008-2009\TIMESHEETS\ & src.Range("D20") & ".xlsm" Set des = Workbooks(src.Range("D20").Value & ".xlsm").Sheets("TIME SHEET") Set des2 = Workbooks(src.Range("D20").Value & ".xlsm") des.Unprotect Password:="TIMESHEET" For I = 4 To 43 src.Range("H" & I) = Format(des.Range("I" & ((3 * I) - 2)), "0%") src.Range("I" & I) = Format(des.Range("J" & ((3 * I) - 2)), "0%") Next I des.Range("I10").Select des.Protect Password:="TIMESHEET", DrawingObjects:=True, Contents:=True, Scenarios:=True des.EnableSelection = xlUnlockedCells des2.Save des2.Close src.Activate Else MsgBox "NO FILE NAME", vbCritical, "ERROR" End If End Sub The macro above open Range("D20").value Workbook and in that workbook copy data into old workbook. In old workbook in Range("H3:M3") I have different workbook names. I want that when macro copy data from new workbook to old workbook it should check Range("H3:M3") and if any cell value match with Range("D20").value it should paste that data one cell below of that cell. At the moment macro copies data fine but i can get to paste data one cell below the macthed value. I think where it say "src.Range("H" & I)" and "src.Range("I" & I)" that need to be something else. Please can you help |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Match Value in Range and Then Paste
Does this work
Sub import() Set src = Workbooks("Book5.xlsm").Sheets("Sheet1") BkName = src.Range("D20").Value If BkName < "" Then Workbooks.Open Filename:= _ "C:\My Document\2008-2009\TIMESHEETS\" & BkName & ".xlsm" Set des = Workbooks(BkName & ".xlsm").Sheets("TIMESHEET") Set des2 = Workbooks(BkName & ".xlsm") des.Unprotect Password:="TIMESHEET" For I = 4 To 43 Set C = src.Range("H3:M3").Find(what:=BkName, _ LookIn:=xlValues, lookat:=xlWhole) If C Is Nothing Then MsgBox ("Cannot find : " & BkName) Else C.Offset(1, 0) = Format(des.Range("I" & ((3 * I) - 2)), "0%") C.Offset(1, 1) = Format(des.Range("J" & ((3 * I) - 2)), "0%") End If Next I des.Range("I10").Select des.Protect _ Password:="TIMESHEET", _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True des.EnableSelection = xlUnlockedCells des2.Save des2.Close src.Activate Else MsgBox "NO FILE NAME", vbCritical, "ERROR" End If End Sub "K" wrote: On Sep 15, 1:32 pm, Joel wrote: Try this Sub test() Set OldWbk = Workbooks("Main.xlsm") Set newbk = Workbooks.Open(Filename:= _ "C:\My Document\" & OldWbk.Range("A1").Value & ".xlsm") For Each cell In newbk.Range("I2:I15") Data = cell.Offset(0, 1) With OldWbk Set c = .Range("D1:F1").Find(what:=cell, _ LookIn:=xlValues, loookat:=xlWhole) If c Is Nothing Then MsgBox ("could not find : " & cell) Else LastRow = .Cells(Rows.Count, c.Column).End(xlUp).Row NewRow = LastRow + 1 .Cells(NewRow, c.Column) = Data End If End With Next cell End Sub "K" wrote: Hi all, I am looking for macro which should do something (see below) EXAMPLE : Sub test () set OldWbk = Workbooks("Main.xlsm") Workbooks.Open Filename:= "C:\My Document\" & OldWbk.Range("A1").Value & ".xlsm" ActiveWorkbook.Range("I2:J15").Copy OldWbk.Select If (any cell.value) in OldWbk.Range("D1:F1") = OldWbk.Range("A1").Value Then Select.Offset.(of that cell).Paste End Sub Above is just rough example that what I want macro to do. Basically I want macro to open workbook of which name is in Range("A1") and then copy data from that workbook and then come back to old workbook and look in each cell of Range("D1:F1") and if any cell have same value to Range("A1") then Paste data one cell below of that cell. Please can any friend help me on this- Hide quoted text - - Show quoted text - Hi joel, Thanks for replying. The actual macro on which I am working with is (see below) Sub import() Set src = Workbooks("Book5.xlsm").Sheets("Sheet1") If src.Range("D20").Value < "" Then Workbooks.Open Filename:= _ C:\My Document\2008-2009\TIMESHEETS\ & src.Range("D20") & ".xlsm" Set des = Workbooks(src.Range("D20").Value & ".xlsm").Sheets("TIME SHEET") Set des2 = Workbooks(src.Range("D20").Value & ".xlsm") des.Unprotect Password:="TIMESHEET" For I = 4 To 43 src.Range("H" & I) = Format(des.Range("I" & ((3 * I) - 2)), "0%") src.Range("I" & I) = Format(des.Range("J" & ((3 * I) - 2)), "0%") Next I des.Range("I10").Select des.Protect Password:="TIMESHEET", DrawingObjects:=True, Contents:=True, Scenarios:=True des.EnableSelection = xlUnlockedCells des2.Save des2.Close src.Activate Else MsgBox "NO FILE NAME", vbCritical, "ERROR" End If End Sub The macro above open Range("D20").value Workbook and in that workbook copy data into old workbook. In old workbook in Range("H3:M3") I have different workbook names. I want that when macro copy data from new workbook to old workbook it should check Range("H3:M3") and if any cell value match with Range("D20").value it should paste that data one cell below of that cell. At the moment macro copies data fine but i can get to paste data one cell below the macthed value. I think where it say "src.Range("H" & I)" and "src.Range("I" & I)" that need to be something else. Please can you help |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Match Value in Range and Then Paste
On Sep 15, 4:44*pm, Joel wrote:
Does this work Sub import() Set src = Workbooks("Book5.xlsm").Sheets("Sheet1") BkName = src.Range("D20").Value If BkName < "" Then Workbooks.Open Filename:= _ * *"C:\My Document\2008-2009\TIMESHEETS\" & BkName & ".xlsm" Set des = Workbooks(BkName & ".xlsm").Sheets("TIMESHEET") Set des2 = Workbooks(BkName & ".xlsm") des.Unprotect Password:="TIMESHEET" For I = 4 To 43 * *Set C = src.Range("H3:M3").Find(what:=BkName, _ * * * LookIn:=xlValues, lookat:=xlWhole) * *If C Is Nothing Then * * * MsgBox ("Cannot find : " & BkName) * *Else * * * C.Offset(1, 0) = Format(des.Range("I" & ((3 * I) - 2)), "0%") * * * C.Offset(1, 1) = Format(des.Range("J" & ((3 * I) - 2)), "0%") * *End If Next I des.Range("I10").Select des.Protect _ * *Password:="TIMESHEET", _ * *DrawingObjects:=True, _ * *Contents:=True, _ * *Scenarios:=True des.EnableSelection = xlUnlockedCells des2.Save des2.Close src.Activate Else MsgBox "NO FILE NAME", vbCritical, "ERROR" End If End Sub "K" wrote: On Sep 15, 1:32 pm, Joel wrote: Try this Sub test() Set OldWbk = Workbooks("Main.xlsm") Set newbk = Workbooks.Open(Filename:= _ * * "C:\My Document\" & OldWbk.Range("A1").Value & ".xlsm") For Each cell In newbk.Range("I2:I15") * *Data = cell.Offset(0, 1) * *With OldWbk * * * Set c = .Range("D1:F1").Find(what:=cell, _ * * * * *LookIn:=xlValues, loookat:=xlWhole) * * * If c Is Nothing Then * * * * *MsgBox ("could not find : " & cell) * * * Else * * * * *LastRow = .Cells(Rows.Count, c.Column).End(xlUp)..Row * * * * *NewRow = LastRow + 1 * * * * *.Cells(NewRow, c.Column) = Data * * * End If * *End With Next cell End Sub "K" wrote: Hi all, *I am looking for macro which should do something (see below) EXAMPLE : Sub test () set OldWbk = Workbooks("Main.xlsm") Workbooks.Open Filename:= "C:\My Document\" & OldWbk.Range("A1").Value & ".xlsm" ActiveWorkbook.Range("I2:J15").Copy OldWbk.Select If (any cell.value) in OldWbk.Range("D1:F1") = OldWbk.Range("A1").Value Then Select.Offset.(of that cell).Paste End Sub Above is just rough example that what I want macro to do. *Basically I want macro to open workbook of which name is in Range("A1") and then copy data from that workbook and then come back to old workbook and look in each cell of Range("D1:F1") and if any cell have same value to Range("A1") then Paste data one cell below of that cell. *Please can any friend help me on this- Hide quoted text - - Show quoted text - Hi joel, *Thanks for replying. *The actual macro on which I am working with is (see below) Sub import() Set src = Workbooks("Book5.xlsm").Sheets("Sheet1") If src.Range("D20").Value < "" Then Workbooks.Open Filename:= _ C:\My Document\2008-2009\TIMESHEETS\ & src.Range("D20") & ".xlsm" Set des = Workbooks(src.Range("D20").Value & ".xlsm").Sheets("TIME SHEET") Set des2 = Workbooks(src.Range("D20").Value & ".xlsm") des.Unprotect Password:="TIMESHEET" For I = 4 To 43 src.Range("H" & I) = Format(des.Range("I" & ((3 * I) - 2)), "0%") src.Range("I" & I) = Format(des.Range("J" & ((3 * I) - 2)), "0%") Next I des.Range("I10").Select des.Protect Password:="TIMESHEET", DrawingObjects:=True, Contents:=True, Scenarios:=True des.EnableSelection = xlUnlockedCells des2.Save des2.Close src.Activate Else MsgBox "NO FILE NAME", vbCritical, "ERROR" End If End Sub The macro above open Range("D20").value Workbook and in that workbook copy data into old workbook. *In old workbook in Range("H3:M3") I have different workbook names. *I want that when macro copy data from new workbook to old workbook it should check Range("H3:M3") and if any cell value match with Range("D20").value it should paste that data one cell below of that cell. *At the moment macro copies data fine but i can get to paste data one cell below the macthed value. *I think where it say "src.Range("H" & I)" and "src.Range("I" & I)" that need to be something else. *Please can you help- Hide quoted text - - Show quoted text - Thanks Joel it works fine. i just changed the lines in your code (see below) C.Offset(1, 0) = Format(des.Range("I" & ((3 * I) - 2)), "0%") C.Offset(1, 1) = Format(des.Range("J" & ((3 * I) - 2)), "0%") to C.Offset(I, 0) = Format(des.Range("I" & ((3 * I) - 2)), "0%") C.Offset(I, 1) = Format(des.Range("J" & ((3 * I) - 2)), "0%") 1 into I |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
match, copy, paste, & color | Excel Programming | |||
Match , copy paste (using find?) | Excel Programming | |||
Compare col and match then copy and paste | Excel Discussion (Misc queries) | |||
Match name colums and paste corresponding values | Excel Discussion (Misc queries) | |||
help with match, copy, paste please | Excel Programming |