![]() |
Need some help with this code:
Hi,
I'm not good in programming in VBA, but I managed to put together the following (thanks to Susan, Ron, JLGwhiz and Dave Miller): The purpose of this is to copy a sheet to a backupfile, so I can gather lots of data to be put in an excelchart. In the inputsheet there's lots of data that's the same, hence the "-character. In the code there's a part that replaces these "-characters by the value above. (see topic: http://www.microsoft.com/communities...2-35d9d717cd39 ) Yet I can't find the way to do this without making a selection. Also, the original sheet may not by altered (which is the case now). My third problem is the static range. I'd like to have a range that is dynamic, cause the data in the input sheet is not always the same amount of rows. And I don't want any blanks in my backupfile. Also, if you can do something with lesser code or if you can simplify the code, it would be of much importance to me. Thanks in advance, and here is the code: ----- Sub Copy_To_Another_Workbook() Dim SourceRange As Range Dim DestRange As Range Dim DestWB As Workbook Dim DestSh As Worksheet Dim Lr As Long 'change the apostrophe to previous value For Each SourceRange In Selection If SourceRange.Value Like Chr(34) Then SourceRange.Value = SourceRange.Offset(-1, 0).Value End If Next With Application .ScreenUpdating = False .EnableEvents = False End With 'Change the file name (2*) and the path/file name to your file If bIsBookOpen_RB("Backup.xls") Then Set DestWB = Workbooks("Backup.xls") Else Set DestWB = Workbooks.Open("o:\data\Backup.xls") End If 'Change the Source Sheet and range Set SourceRange = ThisWorkbook.Sheets("Sheet1").Range("A11:k50") 'Change the sheet name of the database workbook Set DestSh = DestWB.Worksheets("Sheet1") 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 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 ----- |
Need some help with this code:
Yet I can't find the way to do this without making a selection.
My third problem is the static range. I'd like to have a range that is dynamic, cause the data in the input sheet is not always the same amount of rows. Could you use your LastRow And LastCol functions to get the dimensions of your input range? Dim InputSh As Worksheet Dim InputRng As Range Dim x As Long, y As Long Set InputSh = ActiveSheet x = LastRow(InputSh) y = LastCol(InputSh) Set InputRng = InputSh.Range(Cells(1,1),Cells(x,y)) 'change the apostrophe to previous value For Each SourceRange In InputRng etc. As far as altering the source worksheet, why not copy the source rnage into the backup file and THEN do all the manipulations? Or can you simply close the source book without saving changes? Ed On Jan 29, 6:06*am, Koen wrote: Hi, I'm not good in programming in VBA, but I managed to put together the following (thanks to Susan, Ron, JLGwhiz and Dave Miller): The purpose of this is to copy a sheet to a backupfile, so I can gather lots of data to be put in an excelchart. In the inputsheet there's lots of data that's the same, hence the "-character. In the code there's a part that replaces these "-characters by the value above. (see topic:http://www.microsoft.com/communities...efault.aspx?&q...) Yet I can't find the way to do this without making a selection. Also, the original sheet may not by altered (which is the case now). My third problem is the static range. I'd like to have a range that is dynamic, cause the data in the input sheet is not always the same amount of rows. And I don't want any blanks in my backupfile. Also, if you can do something with lesser code or if you can simplify the code, it would be of much importance to me. Thanks in advance, and here is the code: ----- Sub Copy_To_Another_Workbook() * * Dim SourceRange As Range * * Dim DestRange As Range * * Dim DestWB As Workbook * * Dim DestSh As Worksheet * * Dim Lr As Long * * 'change the apostrophe to previous value * * For Each SourceRange In Selection * * * * If SourceRange.Value Like Chr(34) Then * * * * * * SourceRange.Value = SourceRange.Offset(-1, 0).Value * * * * End If * * Next * * With Application * * * * .ScreenUpdating = False * * * * .EnableEvents = False * * End With * * 'Change the file name (2*) and the path/file name to your file * * If bIsBookOpen_RB("Backup.xls") Then * * * * Set DestWB = Workbooks("Backup.xls") * * Else * * * * Set DestWB = Workbooks.Open("o:\data\Backup.xls") * * End If * * 'Change the Source Sheet and range * * Set SourceRange = ThisWorkbook.Sheets("Sheet1").Range("A11:k50") * * 'Change the sheet name of the database workbook * * Set DestSh = DestWB.Worksheets("Sheet1") * * 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 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 ----- |
Need some help with this code:
"Ed from AZ" wrote:
As far as altering the source worksheet, why not copy the source rnage into the backup file and THEN do all the manipulations? Or can you simply close the source book without saving changes? I'm not sure I understand, but I'd like to execute the code on the sourcedata file, because this file is used over and over again. Also, I don't want to have to open the backup file (the purpose is that my colleagues can also execute this). Other problem is that the name of the sourcefile is altered every 2 to 3 days. And actually I can't really program, so I don't really know what every function is used for. |
All times are GMT +1. The time now is 08:20 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com