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

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

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

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

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

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

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

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