Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro copy data into another workbook
I found this small macro which copies the data from my source worksheet
("Data4") Range("A1:C1000") to a different workbook ("C:\Destination.xls"). What it does is that it will look for the next empty row and then copy the data into it. Now I would like to alter the macro so instead of always copying into the next empty row (and eventually create duplicates) it should check for the whole range if an entry from column A in the source range already exists in column A of the detination workbook and in this case overwrite column B and C of this row in the destination workbook. In case it does not exist yet, it should write the data in the empty row as the macro below does already. One more note: the data of the cells in column A of the source worksheet is always unique, there are no duplicates already in the source worksheet. Thanks for your help! Sub Test() Dim bk As Workbook Dim bSave As Boolean Dim lRow As Long ' test to see if Destination.xls is already open On Error Resume Next Set bk = Workbooks("Destination.xls") On Error GoTo 0 If bk Is Nothing Then bSave = True Set bk = Workbooks.Open("C:\Destination.xls") End If 'find first empty row in database lRow = bk.Worksheets("Test").Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row ThisWorkbook.Sheets("Data4").Range("A1:C1000").Cop y _ Destination:=bk.Worksheets("Test").Cells(lRow, 1) ' if destination was originally closed, then save and close it If bSave Then bk.Close Savechanges:=True End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro copy data into another workbook
Sub Test() Dim bk As Workbook Dim bSave As Boolean Dim lRow As Long ' test to see if Destination.xls is already open On Error Resume Next Set bk = Workbooks("Destination.xls") On Error GoTo 0 If bk Is Nothing Then bSave = True Set bk = Workbooks.Open("C:\Destination.xls") End If 'find first empty row in database lRow = bk.Worksheets("Test").Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row With ThisWorkbook.Sheets("Data4") RowCount = 1 Do While .Range("A" & RowCount) < "" FindData = .Range("A" & RowCount) Set c = bk.Columns("A:A").Find(what:=FindData, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & RowCount & ":C" & RowCount).Copy _ Destination:=bk.Worksheets("Test").Range("A" & lRow) lRow = lRow + 1 Else .Range("A" & RowCount & ":C" & RowCount).Copy _ Destination:=bk.Worksheets("Test").Range("A" & c.row) End If RowCount = RowCount + 1 Loop End With ' if destination was originally closed, then save and close it If bSave Then bk.Close Savechanges:=True End Sub "Ingo" wrote: I found this small macro which copies the data from my source worksheet ("Data4") Range("A1:C1000") to a different workbook ("C:\Destination.xls"). What it does is that it will look for the next empty row and then copy the data into it. Now I would like to alter the macro so instead of always copying into the next empty row (and eventually create duplicates) it should check for the whole range if an entry from column A in the source range already exists in column A of the detination workbook and in this case overwrite column B and C of this row in the destination workbook. In case it does not exist yet, it should write the data in the empty row as the macro below does already. One more note: the data of the cells in column A of the source worksheet is always unique, there are no duplicates already in the source worksheet. Thanks for your help! Sub Test() Dim bk As Workbook Dim bSave As Boolean Dim lRow As Long ' test to see if Destination.xls is already open On Error Resume Next Set bk = Workbooks("Destination.xls") On Error GoTo 0 If bk Is Nothing Then bSave = True Set bk = Workbooks.Open("C:\Destination.xls") End If 'find first empty row in database lRow = bk.Worksheets("Test").Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row ThisWorkbook.Sheets("Data4").Range("A1:C1000").Cop y _ Destination:=bk.Worksheets("Test").Cells(lRow, 1) ' if destination was originally closed, then save and close it If bSave Then bk.Close Savechanges:=True End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro copy data into another workbook
Hello Joel,
thanks a lot for the very fast reply. When I copy your changes into the workbook and try to run it, I get back the message "object doesn 't support this property or method". Any idea what could be the reason for this error? I 'm working with Excel 2003 SP3. Thanks! "Joel" wrote: Sub Test() Dim bk As Workbook Dim bSave As Boolean Dim lRow As Long ' test to see if Destination.xls is already open On Error Resume Next Set bk = Workbooks("Destination.xls") On Error GoTo 0 If bk Is Nothing Then bSave = True Set bk = Workbooks.Open("C:\Destination.xls") End If 'find first empty row in database lRow = bk.Worksheets("Test").Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row With ThisWorkbook.Sheets("Data4") RowCount = 1 Do While .Range("A" & RowCount) < "" FindData = .Range("A" & RowCount) Set c = bk.Columns("A:A").Find(what:=FindData, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & RowCount & ":C" & RowCount).Copy _ Destination:=bk.Worksheets("Test").Range("A" & lRow) lRow = lRow + 1 Else .Range("A" & RowCount & ":C" & RowCount).Copy _ Destination:=bk.Worksheets("Test").Range("A" & c.row) End If RowCount = RowCount + 1 Loop End With ' if destination was originally closed, then save and close it If bSave Then bk.Close Savechanges:=True End Sub "Ingo" wrote: I found this small macro which copies the data from my source worksheet ("Data4") Range("A1:C1000") to a different workbook ("C:\Destination.xls"). What it does is that it will look for the next empty row and then copy the data into it. Now I would like to alter the macro so instead of always copying into the next empty row (and eventually create duplicates) it should check for the whole range if an entry from column A in the source range already exists in column A of the detination workbook and in this case overwrite column B and C of this row in the destination workbook. In case it does not exist yet, it should write the data in the empty row as the macro below does already. One more note: the data of the cells in column A of the source worksheet is always unique, there are no duplicates already in the source worksheet. Thanks for your help! Sub Test() Dim bk As Workbook Dim bSave As Boolean Dim lRow As Long ' test to see if Destination.xls is already open On Error Resume Next Set bk = Workbooks("Destination.xls") On Error GoTo 0 If bk Is Nothing Then bSave = True Set bk = Workbooks.Open("C:\Destination.xls") End If 'find first empty row in database lRow = bk.Worksheets("Test").Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row ThisWorkbook.Sheets("Data4").Range("A1:C1000").Cop y _ Destination:=bk.Worksheets("Test").Cells(lRow, 1) ' if destination was originally closed, then save and close it If bSave Then bk.Close Savechanges:=True End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro copy data into another workbook
Sorry, I forgot the worksheet on one line
Set c = bk.Worksheets("Test").Columns("A").Find(what:=Find Data, _ LookIn:=xlValues, lookat:=xlWhole) "Ingo" wrote: Hello Joel, thanks a lot for the very fast reply. When I copy your changes into the workbook and try to run it, I get back the message "object doesn 't support this property or method". Any idea what could be the reason for this error? I 'm working with Excel 2003 SP3. Thanks! "Joel" wrote: Sub Test() Dim bk As Workbook Dim bSave As Boolean Dim lRow As Long ' test to see if Destination.xls is already open On Error Resume Next Set bk = Workbooks("Destination.xls") On Error GoTo 0 If bk Is Nothing Then bSave = True Set bk = Workbooks.Open("C:\Destination.xls") End If 'find first empty row in database lRow = bk.Worksheets("Test").Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row With ThisWorkbook.Sheets("Data4") RowCount = 1 Do While .Range("A" & RowCount) < "" FindData = .Range("A" & RowCount) Set c = bk.Columns("A:A").Find(what:=FindData, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & RowCount & ":C" & RowCount).Copy _ Destination:=bk.Worksheets("Test").Range("A" & lRow) lRow = lRow + 1 Else .Range("A" & RowCount & ":C" & RowCount).Copy _ Destination:=bk.Worksheets("Test").Range("A" & c.row) End If RowCount = RowCount + 1 Loop End With ' if destination was originally closed, then save and close it If bSave Then bk.Close Savechanges:=True End Sub "Ingo" wrote: I found this small macro which copies the data from my source worksheet ("Data4") Range("A1:C1000") to a different workbook ("C:\Destination.xls"). What it does is that it will look for the next empty row and then copy the data into it. Now I would like to alter the macro so instead of always copying into the next empty row (and eventually create duplicates) it should check for the whole range if an entry from column A in the source range already exists in column A of the detination workbook and in this case overwrite column B and C of this row in the destination workbook. In case it does not exist yet, it should write the data in the empty row as the macro below does already. One more note: the data of the cells in column A of the source worksheet is always unique, there are no duplicates already in the source worksheet. Thanks for your help! Sub Test() Dim bk As Workbook Dim bSave As Boolean Dim lRow As Long ' test to see if Destination.xls is already open On Error Resume Next Set bk = Workbooks("Destination.xls") On Error GoTo 0 If bk Is Nothing Then bSave = True Set bk = Workbooks.Open("C:\Destination.xls") End If 'find first empty row in database lRow = bk.Worksheets("Test").Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row ThisWorkbook.Sheets("Data4").Range("A1:C1000").Cop y _ Destination:=bk.Worksheets("Test").Cells(lRow, 1) ' if destination was originally closed, then save and close it If bSave Then bk.Close Savechanges:=True End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro copy data into another workbook
Thanks again Joel, it works perfectly now! Sorry to border you again, just
one more question: will this macro also work if the destination workbook is a shared workbook und different users are using this code at the same time to export some data into the destination workbook? "Joel" wrote: Sorry, I forgot the worksheet on one line Set c = bk.Worksheets("Test").Columns("A").Find(what:=Find Data, _ LookIn:=xlValues, lookat:=xlWhole) "Ingo" wrote: Hello Joel, thanks a lot for the very fast reply. When I copy your changes into the workbook and try to run it, I get back the message "object doesn 't support this property or method". Any idea what could be the reason for this error? I 'm working with Excel 2003 SP3. Thanks! "Joel" wrote: Sub Test() Dim bk As Workbook Dim bSave As Boolean Dim lRow As Long ' test to see if Destination.xls is already open On Error Resume Next Set bk = Workbooks("Destination.xls") On Error GoTo 0 If bk Is Nothing Then bSave = True Set bk = Workbooks.Open("C:\Destination.xls") End If 'find first empty row in database lRow = bk.Worksheets("Test").Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row With ThisWorkbook.Sheets("Data4") RowCount = 1 Do While .Range("A" & RowCount) < "" FindData = .Range("A" & RowCount) Set c = bk.Columns("A:A").Find(what:=FindData, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & RowCount & ":C" & RowCount).Copy _ Destination:=bk.Worksheets("Test").Range("A" & lRow) lRow = lRow + 1 Else .Range("A" & RowCount & ":C" & RowCount).Copy _ Destination:=bk.Worksheets("Test").Range("A" & c.row) End If RowCount = RowCount + 1 Loop End With ' if destination was originally closed, then save and close it If bSave Then bk.Close Savechanges:=True End Sub "Ingo" wrote: I found this small macro which copies the data from my source worksheet ("Data4") Range("A1:C1000") to a different workbook ("C:\Destination.xls"). What it does is that it will look for the next empty row and then copy the data into it. Now I would like to alter the macro so instead of always copying into the next empty row (and eventually create duplicates) it should check for the whole range if an entry from column A in the source range already exists in column A of the detination workbook and in this case overwrite column B and C of this row in the destination workbook. In case it does not exist yet, it should write the data in the empty row as the macro below does already. One more note: the data of the cells in column A of the source worksheet is always unique, there are no duplicates already in the source worksheet. Thanks for your help! Sub Test() Dim bk As Workbook Dim bSave As Boolean Dim lRow As Long ' test to see if Destination.xls is already open On Error Resume Next Set bk = Workbooks("Destination.xls") On Error GoTo 0 If bk Is Nothing Then bSave = True Set bk = Workbooks.Open("C:\Destination.xls") End If 'find first empty row in database lRow = bk.Worksheets("Test").Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row ThisWorkbook.Sheets("Data4").Range("A1:C1000").Cop y _ Destination:=bk.Worksheets("Test").Cells(lRow, 1) ' if destination was originally closed, then save and close it If bSave Then bk.Close Savechanges:=True End Sub |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro copy data into another workbook
There are two issues with shared workbooks. first are the permissions. As
long as everybody has write permission to the file then this should not be an issue. Second, only the first person who opens the workbook has write permission, the others have read only. So if two people try to access the file at the same time only one will be able to write to the file. "Ingo" wrote: Thanks again Joel, it works perfectly now! Sorry to border you again, just one more question: will this macro also work if the destination workbook is a shared workbook und different users are using this code at the same time to export some data into the destination workbook? "Joel" wrote: Sorry, I forgot the worksheet on one line Set c = bk.Worksheets("Test").Columns("A").Find(what:=Find Data, _ LookIn:=xlValues, lookat:=xlWhole) "Ingo" wrote: Hello Joel, thanks a lot for the very fast reply. When I copy your changes into the workbook and try to run it, I get back the message "object doesn 't support this property or method". Any idea what could be the reason for this error? I 'm working with Excel 2003 SP3. Thanks! "Joel" wrote: Sub Test() Dim bk As Workbook Dim bSave As Boolean Dim lRow As Long ' test to see if Destination.xls is already open On Error Resume Next Set bk = Workbooks("Destination.xls") On Error GoTo 0 If bk Is Nothing Then bSave = True Set bk = Workbooks.Open("C:\Destination.xls") End If 'find first empty row in database lRow = bk.Worksheets("Test").Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row With ThisWorkbook.Sheets("Data4") RowCount = 1 Do While .Range("A" & RowCount) < "" FindData = .Range("A" & RowCount) Set c = bk.Columns("A:A").Find(what:=FindData, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & RowCount & ":C" & RowCount).Copy _ Destination:=bk.Worksheets("Test").Range("A" & lRow) lRow = lRow + 1 Else .Range("A" & RowCount & ":C" & RowCount).Copy _ Destination:=bk.Worksheets("Test").Range("A" & c.row) End If RowCount = RowCount + 1 Loop End With ' if destination was originally closed, then save and close it If bSave Then bk.Close Savechanges:=True End Sub "Ingo" wrote: I found this small macro which copies the data from my source worksheet ("Data4") Range("A1:C1000") to a different workbook ("C:\Destination.xls"). What it does is that it will look for the next empty row and then copy the data into it. Now I would like to alter the macro so instead of always copying into the next empty row (and eventually create duplicates) it should check for the whole range if an entry from column A in the source range already exists in column A of the detination workbook and in this case overwrite column B and C of this row in the destination workbook. In case it does not exist yet, it should write the data in the empty row as the macro below does already. One more note: the data of the cells in column A of the source worksheet is always unique, there are no duplicates already in the source worksheet. Thanks for your help! Sub Test() Dim bk As Workbook Dim bSave As Boolean Dim lRow As Long ' test to see if Destination.xls is already open On Error Resume Next Set bk = Workbooks("Destination.xls") On Error GoTo 0 If bk Is Nothing Then bSave = True Set bk = Workbooks.Open("C:\Destination.xls") End If 'find first empty row in database lRow = bk.Worksheets("Test").Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row ThisWorkbook.Sheets("Data4").Range("A1:C1000").Cop y _ Destination:=bk.Worksheets("Test").Cells(lRow, 1) ' if destination was originally closed, then save and close it If bSave Then bk.Close Savechanges:=True End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copy most recent data from one workbook to another with a Macro | Excel Discussion (Misc queries) | |||
Macro Help. Copy data from 1 workbook to another on next available | Excel Discussion (Misc queries) | |||
Macro to copy data into another workbook | Excel Discussion (Misc queries) | |||
Macro to copy data from one workbook to another | Excel Programming | |||
macro to copy range data from another workbook | Excel Programming |