Home |
Search |
Today's Posts |
#1
|
|||
|
|||
VBA code to Add data to exsiting worksheet
Hi, I got this code from the net, but I wish to modify it so that it can add data to the exsiting Master sheet whenever a new worksheet has been added to the exsiting workbook which already contain other sheets. I also try with the Function LastRow but it didn't give the results I want. I hope some experts can please kindly help to take a look to modify the codes. Any similar ideas also accepted. Thankyou very much for any guides. The codes are as below: Option Explicit Sub CopyRange() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long If SheetExists("Master") = True Then MsgBox "The sheet Master already exist" Exit Sub End If Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh.Name = "Master" For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name Then If sh.UsedRange.Count 1 Then Last = LastRow(DestSh) sh.Range("A1:C5").Copy DestSh.Cells(Last + 1, 1) End If End If Next Application.ScreenUpdating = True End Sub Sub CopyRangeValues() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long If SheetExists("Master") = True Then MsgBox "The sheet Master already exist" Exit Sub End If Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh.Name = "Master" For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name Then If sh.UsedRange.Count 1 Then Last = LastRow(DestSh) With sh.Range("A1:C5") DestSh.Cells(Last + 1, 1).Resize(.Rows.Count, _ .Columns.Count).Value = .Value End With End If End If Next Application.ScreenUpdating = True 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 SheetExists(SName As String, _ Optional ByVal WB As Workbook) As Boolean On Error Resume Next If WB Is Nothing Then Set WB = ThisWorkbook SheetExists = CBool(Len(Sheets(SName).Name)) End Function -- jonesaa05 ------------------------------------------------------------------------ jonesaa05's Profile: http://www.excelforum.com/member.php...o&userid=28021 View this thread: http://www.excelforum.com/showthread...hreadid=475287 |
#2
|
|||
|
|||
It looks like the CopyRange and CopyRangeValues subroutines both do about the
same thing. Each combines all the existing data on all the other worksheets and puts it onto a Worksheet called master. But the CopyRange version copies the cells (including formulas and formats), while the copyrangevalues just takes the values from each sheet (avoiding formulas and formats). So pick the one you want and delete the other. Then, since they each rebuild the master worksheet, you can just delete the existing master worksheet first. Then run the macro. Try this against a copy of your workbook--just to make sure it does what you want. === Knowing which sheet was new and when to copy that data may be more difficult than just recreating the master worksheet. But as an alternative, you could just copy the range to the bottom of the master worksheet when you want. If you record a macro when you try this, your code could be very close to done. Post back if you need help making it more general. jonesaa05 wrote: Hi, I got this code from the net, but I wish to modify it so that it can add data to the exsiting Master sheet whenever a new worksheet has been added to the exsiting workbook which already contain other sheets. I also try with the Function LastRow but it didn't give the results I want. I hope some experts can please kindly help to take a look to modify the codes. Any similar ideas also accepted. Thankyou very much for any guides. The codes are as below: Option Explicit Sub CopyRange() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long If SheetExists("Master") = True Then MsgBox "The sheet Master already exist" Exit Sub End If Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh.Name = "Master" For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name Then If sh.UsedRange.Count 1 Then Last = LastRow(DestSh) sh.Range("A1:C5").Copy DestSh.Cells(Last + 1, 1) End If End If Next Application.ScreenUpdating = True End Sub Sub CopyRangeValues() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long If SheetExists("Master") = True Then MsgBox "The sheet Master already exist" Exit Sub End If Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh.Name = "Master" For Each sh In ThisWorkbook.Worksheets If sh.Name < DestSh.Name Then If sh.UsedRange.Count 1 Then Last = LastRow(DestSh) With sh.Range("A1:C5") DestSh.Cells(Last + 1, 1).Resize(.Rows.Count, _ Columns.Count).Value = .Value End With End If End If Next Application.ScreenUpdating = True 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 SheetExists(SName As String, _ Optional ByVal WB As Workbook) As Boolean On Error Resume Next If WB Is Nothing Then Set WB = ThisWorkbook SheetExists = CBool(Len(Sheets(SName).Name)) End Function -- jonesaa05 ------------------------------------------------------------------------ jonesaa05's Profile: http://www.excelforum.com/member.php...o&userid=28021 View this thread: http://www.excelforum.com/showthread...hreadid=475287 -- Dave Peterson |
#3
|
|||
|
|||
First, thanks Dave for your tips. Now, I try to run the code to copy the same range (say A1:L10)from 2 workbooks. The code suppose to copy the range values from first sheet in each workbook. It does copy the range I needed into the first sheet but only values from workbook 1 and no values from workbook2. Seems that somthing to do with the looping. I am now seeking for help to do something with the code so that once the macro is run, the same ranges for all the workbook can be copied into the sheets accordingly. Is this possible to do? Thankyou very much in advance. Regards, amy -- jonesaa05 ------------------------------------------------------------------------ jonesaa05's Profile: http://www.excelforum.com/member.php...o&userid=28021 View this thread: http://www.excelforum.com/showthread...hreadid=475287 |
#4
|
|||
|
|||
The code you posted doesn't copy from different workbooks. It copies from
different worksheets within the same workbook. Ron has lots of sample code on that page. I'm not sure which one you're using. You may want to post your efforts once again. jonesaa05 wrote: First, thanks Dave for your tips. Now, I try to run the code to copy the same range (say A1:L10)from 2 workbooks. The code suppose to copy the range values from first sheet in each workbook. It does copy the range I needed into the first sheet but only values from workbook 1 and no values from workbook2. Seems that somthing to do with the looping. I am now seeking for help to do something with the code so that once the macro is run, the same ranges for all the workbook can be copied into the sheets accordingly. Is this possible to do? Thankyou very much in advance. Regards, amy -- jonesaa05 ------------------------------------------------------------------------ jonesaa05's Profile: http://www.excelforum.com/member.php...o&userid=28021 View this thread: http://www.excelforum.com/showthread...hreadid=475287 -- Dave Peterson |
#5
|
|||
|
|||
Hi, Dave I post the code which I use to copy values from at least 2 workbook in the same folder. Only the values from 1 workbook are correctly copied. The others give 0 values. Please help me to have a look whether the is the code problems. One more thing, which line of code to be changed if I don't want to copy to the first sheet. Sorry, I am still novice to VBA coding things. Thanks in advanced, amy Sub CopyRangeValues() Dim basebook As Workbook Dim mybook As Workbook Dim sourceRange As Range Dim destrange As Range Dim rnum As Long Dim i As Long Dim a As Long Application.ScreenUpdating = False With Application.FileSearch .NewSearch .LookIn = "D:\Data\" .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then Set basebook = ThisWorkbook rnum = 1 For i = 1 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) Set sourceRange = mybook.Worksheets(1).Range("a1:k10") a = sourceRange.Rows.Count With sourceRange Set destrange = basebook.Worksheets(1).Cells(rnum, 1). _ Resize(.Rows.Count, .Columns.Count) End With destrange.Value = sourceRange.Value mybook.Close rnum = i * a + 1 'What does this means?? Next i End If End With Application.ScreenUpdating = True End Sub -- jonesaa05 ------------------------------------------------------------------------ jonesaa05's Profile: http://www.excelforum.com/member.php...o&userid=28021 View this thread: http://www.excelforum.com/showthread...hreadid=475287 |
#6
|
|||
|
|||
This is the line that says where to copy the data from:
Set sourceRange = mybook.Worksheets(1).Range("a1:k10") That worksheets(1) means the left most worksheet when you're looking at the worksheet tabs. If the name of the worksheet is always the same (say "Sheet99"), you could use: Set sourceRange = mybook.Worksheets("Sheet99").Range("a1:k10") Do you know the name of the sheets that should be copied? And are they always that same name? ====== As for this portion: rnum = i * a + 1 'What does this means?? Ron's sample code always uses A1:K10. That's 10 rows of data. He also makes it easier for you to customize his code. If your range is different, you could use: Set sourceRange = mybook.Worksheets("Sheet99").Range("a1:G100") That would take a 100 rows of values (A:G) The next line determines how many rows per "copy". a = sourceRange.Rows.Count In Ron's sample, "a" will be 10. It's the number of rows in A1:K10. rnum = i * a + 1 'What does this means?? In this line, rnum is the next row that's gonna get the values from the next workbook that's opened. i represents a counter of which file you're on. Right after a set of data is populated, Ron says to take the number of rows per "copy" and multiply it by the number of files that have been processed. Then add 1. So right after the first workbook's A1:K10 is put into the new worksheet, Ron's code will evaluate to: rnum = i * a + 1 rnum = 1 * 10 + 1 rnum = 10 + 1 rnum = 11 So the next time through, Ron will start in row 11. Then the next time, it'll be 21 (2*10+1), then 31 (3*10+1). All this works because Ron is taking the values from 10 rows each time. Ps. Ron isn't really copy|pasting. He's just assigning values. That's what this line does: destrange.Value = sourceRange.Value ======== So the code is probably working ok. But you have to make sure your situation fits this code. #1. Same worksheet name in each workbook #2. Same range "copied" to the new worksheet. If these two aren't true, then Ron's code would have to be modified. But you'll have to say what you really want. jonesaa05 wrote: Hi, Dave I post the code which I use to copy values from at least 2 workbook in the same folder. Only the values from 1 workbook are correctly copied. The others give 0 values. Please help me to have a look whether the is the code problems. One more thing, which line of code to be changed if I don't want to copy to the first sheet. Sorry, I am still novice to VBA coding things. Thanks in advanced, amy Sub CopyRangeValues() Dim basebook As Workbook Dim mybook As Workbook Dim sourceRange As Range Dim destrange As Range Dim rnum As Long Dim i As Long Dim a As Long Application.ScreenUpdating = False With Application.FileSearch NewSearch LookIn = "D:\Data\" SearchSubFolders = False FileType = msoFileTypeExcelWorkbooks If .Execute() 0 Then Set basebook = ThisWorkbook rnum = 1 For i = 1 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) Set sourceRange = mybook.Worksheets(1).Range("a1:k10") a = sourceRange.Rows.Count With sourceRange Set destrange = basebook.Worksheets(1).Cells(rnum, 1). _ Resize(.Rows.Count, Columns.Count) End With destrange.Value = sourceRange.Value mybook.Close rnum = i * a + 1 'What does this means?? Next i End If End With Application.ScreenUpdating = True End Sub -- jonesaa05 ------------------------------------------------------------------------ jonesaa05's Profile: http://www.excelforum.com/member.php...o&userid=28021 View this thread: http://www.excelforum.com/showthread...hreadid=475287 -- Dave Peterson |
#7
|
|||
|
|||
Dear Dave, First, if to make the code work ok, I can manually make the same worksheet name in each workbook. But, I also need the same range of every sheet to be"copied " to the new worksheet. So, the code would have to be modified like what you said. Correct me if I am wrong. My question is : How does it can be done? Thanks, amy -- jonesaa05 ------------------------------------------------------------------------ jonesaa05's Profile: http://www.excelforum.com/member.php...o&userid=28021 View this thread: http://www.excelforum.com/showthread...hreadid=475287 |
#8
|
|||
|
|||
That's correct.
I would think that the only line you'll be changing in the code is this: Set sourceRange = mybook.Worksheets("Sheet99").Range("a1:k10") Change sheet99 to whatever you call all those sheets and change a1:k10 to whatever range you want copied. jonesaa05 wrote: Dear Dave, First, if to make the code work ok, I can manually make the same worksheet name in each workbook. But, I also need the same range of every sheet to be"copied " to the new worksheet. So, the code would have to be modified like what you said. Correct me if I am wrong. My question is : How does it can be done? Thanks, amy -- jonesaa05 ------------------------------------------------------------------------ jonesaa05's Profile: http://www.excelforum.com/member.php...o&userid=28021 View this thread: http://www.excelforum.com/showthread...hreadid=475287 -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Change case...help please | Excel Worksheet Functions | |||
Automatically pasting worksheet data to new worksheet with formulas | Excel Worksheet Functions | |||
Macro for changing text to Proper Case | Excel Worksheet Functions | |||
Validating data pasted into worksheet | Excel Discussion (Misc queries) | |||
Extending a Chart Data Series from an Array - Can it be done? | Charts and Charting in Excel |