Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need assistance with code, please
Hi,
I am using Rons code to copy a range from one workbook to another and it works well. The problem I am having is that the source range is not always the same number of rows but will always have the same number of columns. So I am getting blank rows inserted into destination workbook (which happens to be a LIST). My source range is A2:AA1000, How can I change the code below so that my source range will only copy to the last row of data. Your help appreciated as always Thanks Winnie Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If 'Change the Source Sheet and range Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA1000") 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need assistance with code, please
I need to know more about your worksheet and where the blank row(s) are
located. There are few methods that may solve your problem. 1) If there are no blank rows (or cell) in your data you can use end(xldown). 2) If there are no data below your table you can use End(xlup) and select the last row of the worksheet. 3) If you have blank data in the middle of your data the PasteSpecial has ignore blanks option. I have found that this often doesn't work 4) I've found that doing a sort in Descending order will move the blanks to the bottom of the table. "winnie123" wrote: Hi, I am using Rons code to copy a range from one workbook to another and it works well. The problem I am having is that the source range is not always the same number of rows but will always have the same number of columns. So I am getting blank rows inserted into destination workbook (which happens to be a LIST). My source range is A2:AA1000, How can I change the code below so that my source range will only copy to the last row of data. Your help appreciated as always Thanks Winnie Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If 'Change the Source Sheet and range Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA1000") 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need assistance with code, please
Hi Joel,
I run a monthly report for sale of parts so the column A:AA will always be there. The number of rows is dependant on how many sales there has been, so one month it could be 200 rows, the next it could be 599 rows. I generate the report from the AS/400 and use a rive mask to put it into excell, then copy it to my source file. There are no blank rows below the last line of data in my source file Where would I put the end(xldown). Thanks Winnie "Joel" wrote: I need to know more about your worksheet and where the blank row(s) are located. There are few methods that may solve your problem. 1) If there are no blank rows (or cell) in your data you can use end(xldown). 2) If there are no data below your table you can use End(xlup) and select the last row of the worksheet. 3) If you have blank data in the middle of your data the PasteSpecial has ignore blanks option. I have found that this often doesn't work 4) I've found that doing a sort in Descending order will move the blanks to the bottom of the table. "winnie123" wrote: Hi, I am using Rons code to copy a range from one workbook to another and it works well. The problem I am having is that the source range is not always the same number of rows but will always have the same number of columns. So I am getting blank rows inserted into destination workbook (which happens to be a LIST). My source range is A2:AA1000, How can I change the code below so that my source range will only copy to the last row of data. Your help appreciated as always Thanks Winnie Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If 'Change the Source Sheet and range Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA1000") 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need assistance with code, please
Winnie,
I'm surprised you say this works well because from what you've posted it doesn't This bit suggests you call another sub to test if the workbook is open so i'll assume it works and leave it at that. I commented it out to make the code work for me If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If I think this is the cause of your problem Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA1000") Note in my revised code AA1000 is changed to be the actual used rows Likewise this bit doesn't work If you look at the change in my code below Lastrow and as a result Lr now are set with a value of the last used row of DestSh Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file ' If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") ' Else ' Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") 'End If 'Change the Source Sheet and range LastrowSrc = Sheets("SALES1").Cells(Rows.Count, "A").End(xlUp).Row Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA" & LastrowSrc) 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") LastRow = DestSh.Cells(Rows.Count, "A").End(xlUp).Row Lr = LastRow Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value ' DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub Mike "winnie123" wrote: Hi, I am using Rons code to copy a range from one workbook to another and it works well. The problem I am having is that the source range is not always the same number of rows but will always have the same number of columns. So I am getting blank rows inserted into destination workbook (which happens to be a LIST). My source range is A2:AA1000, How can I change the code below so that my source range will only copy to the last row of data. Your help appreciated as always Thanks Winnie Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If 'Change the Source Sheet and range Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA1000") 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need assistance with code, please
Her is my version of the LastRow Function Function LastRow(sht) LastRow = sht.Range("A" & Rows.Count).End(xlup).Row End Function "winnie123" wrote: Hi Joel, I run a monthly report for sale of parts so the column A:AA will always be there. The number of rows is dependant on how many sales there has been, so one month it could be 200 rows, the next it could be 599 rows. I generate the report from the AS/400 and use a rive mask to put it into excell, then copy it to my source file. There are no blank rows below the last line of data in my source file Where would I put the end(xldown). Thanks Winnie "Joel" wrote: I need to know more about your worksheet and where the blank row(s) are located. There are few methods that may solve your problem. 1) If there are no blank rows (or cell) in your data you can use end(xldown). 2) If there are no data below your table you can use End(xlup) and select the last row of the worksheet. 3) If you have blank data in the middle of your data the PasteSpecial has ignore blanks option. I have found that this often doesn't work 4) I've found that doing a sort in Descending order will move the blanks to the bottom of the table. "winnie123" wrote: Hi, I am using Rons code to copy a range from one workbook to another and it works well. The problem I am having is that the source range is not always the same number of rows but will always have the same number of columns. So I am getting blank rows inserted into destination workbook (which happens to be a LIST). My source range is A2:AA1000, How can I change the code below so that my source range will only copy to the last row of data. Your help appreciated as always Thanks Winnie Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If 'Change the Source Sheet and range Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA1000") 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need assistance with code, please
I have copied your code and I get a Compile error, argument not optional on
the line LastRow = DestSh.Cells(Rows.Count, "A").End(xlUp).Row I am sorry I am pretty useless when it comes to macro's I also have the functions below above my code, not sure if this makes any difference. I copied them from Rons page as without it the macro didnt seem to work Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function Function bIsBookOpen_RB(ByRef szBookName As String) As Boolean ' Rob Bovey On Error Resume Next bIsBookOpen_RB = Not (Application.Workbooks(szBookName) Is Nothing) End Function Thank you "Mike H" wrote: Winnie, I'm surprised you say this works well because from what you've posted it doesn't This bit suggests you call another sub to test if the workbook is open so i'll assume it works and leave it at that. I commented it out to make the code work for me If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If I think this is the cause of your problem Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA1000") Note in my revised code AA1000 is changed to be the actual used rows Likewise this bit doesn't work If you look at the change in my code below Lastrow and as a result Lr now are set with a value of the last used row of DestSh Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file ' If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") ' Else ' Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") 'End If 'Change the Source Sheet and range LastrowSrc = Sheets("SALES1").Cells(Rows.Count, "A").End(xlUp).Row Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA" & LastrowSrc) 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") LastRow = DestSh.Cells(Rows.Count, "A").End(xlUp).Row Lr = LastRow Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value ' DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub Mike "winnie123" wrote: Hi, I am using Rons code to copy a range from one workbook to another and it works well. The problem I am having is that the source range is not always the same number of rows but will always have the same number of columns. So I am getting blank rows inserted into destination workbook (which happens to be a LIST). My source range is A2:AA1000, How can I change the code below so that my source range will only copy to the last row of data. Your help appreciated as always Thanks Winnie Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If 'Change the Source Sheet and range Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA1000") 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need assistance with code, please
Winnie,
Now that makes a lot more sense with those funxtions, Try this Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If 'Change the Source Sheet and range LastRowsrc = ThisWorkbook.Sheets("SALES1").Cells(Rows.Count, "H").End(xlUp).Row Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA" & LastRowsrc) 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub Mike "winnie123" wrote: I have copied your code and I get a Compile error, argument not optional on the line LastRow = DestSh.Cells(Rows.Count, "A").End(xlUp).Row I am sorry I am pretty useless when it comes to macro's I also have the functions below above my code, not sure if this makes any difference. I copied them from Rons page as without it the macro didnt seem to work Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function Function bIsBookOpen_RB(ByRef szBookName As String) As Boolean ' Rob Bovey On Error Resume Next bIsBookOpen_RB = Not (Application.Workbooks(szBookName) Is Nothing) End Function Thank you "Mike H" wrote: Winnie, I'm surprised you say this works well because from what you've posted it doesn't This bit suggests you call another sub to test if the workbook is open so i'll assume it works and leave it at that. I commented it out to make the code work for me If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If I think this is the cause of your problem Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA1000") Note in my revised code AA1000 is changed to be the actual used rows Likewise this bit doesn't work If you look at the change in my code below Lastrow and as a result Lr now are set with a value of the last used row of DestSh Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file ' If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") ' Else ' Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") 'End If 'Change the Source Sheet and range LastrowSrc = Sheets("SALES1").Cells(Rows.Count, "A").End(xlUp).Row Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA" & LastrowSrc) 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") LastRow = DestSh.Cells(Rows.Count, "A").End(xlUp).Row Lr = LastRow Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value ' DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub Mike "winnie123" wrote: Hi, I am using Rons code to copy a range from one workbook to another and it works well. The problem I am having is that the source range is not always the same number of rows but will always have the same number of columns. So I am getting blank rows inserted into destination workbook (which happens to be a LIST). My source range is A2:AA1000, How can I change the code below so that my source range will only copy to the last row of data. Your help appreciated as always Thanks Winnie Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If 'Change the Source Sheet and range Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA1000") 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need assistance with code, please
Thanks Mike, it works like a dream.
Winnie "Mike H" wrote: Winnie, Now that makes a lot more sense with those funxtions, Try this Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If 'Change the Source Sheet and range LastRowsrc = ThisWorkbook.Sheets("SALES1").Cells(Rows.Count, "H").End(xlUp).Row Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA" & LastRowsrc) 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub Mike "winnie123" wrote: I have copied your code and I get a Compile error, argument not optional on the line LastRow = DestSh.Cells(Rows.Count, "A").End(xlUp).Row I am sorry I am pretty useless when it comes to macro's I also have the functions below above my code, not sure if this makes any difference. I copied them from Rons page as without it the macro didnt seem to work Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function Function bIsBookOpen_RB(ByRef szBookName As String) As Boolean ' Rob Bovey On Error Resume Next bIsBookOpen_RB = Not (Application.Workbooks(szBookName) Is Nothing) End Function Thank you "Mike H" wrote: Winnie, I'm surprised you say this works well because from what you've posted it doesn't This bit suggests you call another sub to test if the workbook is open so i'll assume it works and leave it at that. I commented it out to make the code work for me If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If I think this is the cause of your problem Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA1000") Note in my revised code AA1000 is changed to be the actual used rows Likewise this bit doesn't work If you look at the change in my code below Lastrow and as a result Lr now are set with a value of the last used row of DestSh Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file ' If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") ' Else ' Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") 'End If 'Change the Source Sheet and range LastrowSrc = Sheets("SALES1").Cells(Rows.Count, "A").End(xlUp).Row Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA" & LastrowSrc) 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") LastRow = DestSh.Cells(Rows.Count, "A").End(xlUp).Row Lr = LastRow Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value ' DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub Mike "winnie123" wrote: Hi, I am using Rons code to copy a range from one workbook to another and it works well. The problem I am having is that the source range is not always the same number of rows but will always have the same number of columns. So I am getting blank rows inserted into destination workbook (which happens to be a LIST). My source range is A2:AA1000, How can I change the code below so that my source range will only copy to the last row of data. Your help appreciated as always Thanks Winnie Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If 'Change the Source Sheet and range Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA1000") 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need assistance with code, please
Glad I could help
"winnie123" wrote: Thanks Mike, it works like a dream. Winnie "Mike H" wrote: Winnie, Now that makes a lot more sense with those funxtions, Try this Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If 'Change the Source Sheet and range LastRowsrc = ThisWorkbook.Sheets("SALES1").Cells(Rows.Count, "H").End(xlUp).Row Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA" & LastRowsrc) 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub Mike "winnie123" wrote: I have copied your code and I get a Compile error, argument not optional on the line LastRow = DestSh.Cells(Rows.Count, "A").End(xlUp).Row I am sorry I am pretty useless when it comes to macro's I also have the functions below above my code, not sure if this makes any difference. I copied them from Rons page as without it the macro didnt seem to work Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function Function bIsBookOpen_RB(ByRef szBookName As String) As Boolean ' Rob Bovey On Error Resume Next bIsBookOpen_RB = Not (Application.Workbooks(szBookName) Is Nothing) End Function Thank you "Mike H" wrote: Winnie, I'm surprised you say this works well because from what you've posted it doesn't This bit suggests you call another sub to test if the workbook is open so i'll assume it works and leave it at that. I commented it out to make the code work for me If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If I think this is the cause of your problem Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA1000") Note in my revised code AA1000 is changed to be the actual used rows Likewise this bit doesn't work If you look at the change in my code below Lastrow and as a result Lr now are set with a value of the last used row of DestSh Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file ' If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") ' Else ' Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") 'End If 'Change the Source Sheet and range LastrowSrc = Sheets("SALES1").Cells(Rows.Count, "A").End(xlUp).Row Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA" & LastrowSrc) 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") LastRow = DestSh.Cells(Rows.Count, "A").End(xlUp).Row Lr = LastRow Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value ' DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub Mike "winnie123" wrote: Hi, I am using Rons code to copy a range from one workbook to another and it works well. The problem I am having is that the source range is not always the same number of rows but will always have the same number of columns. So I am getting blank rows inserted into destination workbook (which happens to be a LIST). My source range is A2:AA1000, How can I change the code below so that my source range will only copy to the last row of data. Your help appreciated as always Thanks Winnie Sub Copy_To_DATA2009_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file If bIsBookOpen_RB("DATA 2009.xls") Then Set DestWB = Workbooks("DATA 2009.xls") Else Set DestWB = Workbooks.Open("C:\Spares sales\DATA 2009.xls") End If 'Change the Source Sheet and range Set SourceRange = ThisWorkbook.Sheets("SALES1").Range("A2:AA1000") 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("2009") Lr = LastRow(DestSh) Set DestRange = DestSh.Range("A" & Lr + 1) 'We make DestRange the same size as SourceRange and use the Value 'property to give DestRange the same values With SourceRange Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) End With DestRange.Value = SourceRange.Value DestWB.Close savechanges:=True With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Code assistance | Excel Programming | |||
Help with code assistance | Excel Programming | |||
Assistance with VBA code on MAC | Excel Programming | |||
I need assistance getting VBA code to do the following... | Excel Programming | |||
VBA Code Assistance | Excel Programming |