Solved

Match Worksheet Name In Different Workbook and copy data over.

Posted on 2011-03-24
7
443 Views
Last Modified: 2012-05-11
Hi Experts,

I've looked through various answers on here and i've even tried some of the solutions and despite the solution working for other peoples problems, i've been unable to change the code around to suit my needs, which brings me here..

Every day we receive an excel file from our Tools team.
In that Workbook is a single sheet which contains Syslog messages for various network switches. I have managed to create a macro that will take the Switch Name, create a Worksheet with that switches name and then copies/pastes every row of data that relates to that particular switch onto the associated Worksheet. It then adds 'Todays date' so we know when this issue was acknowledged.
Put simply, it distributes the information for each switch, along with the date to it's own Worksheet, which is exactly what i want.

I would then like to copy each Worksheet from this Workbook to a Central Workbook.
The problem is the Central Workbook (Syslog.xls) already has these Worksheet names (because i added them), so i don't want to overwrite the information that is already on these Worksheets, merely add to them.

I already have a solution, but it's very clunky in that i have it look to the SourceWB, activate Sheet1 (for example) copy all data, Switch over to DestinationWB (Syslog.xls), activate Sheet1, find last used row, drop down to the last row, paste data, Switch back to SourceWB, go to Sheet2 etc etc....

My problem is that i've found more sheets being created (as Network switches are being added) than i have allowed, so i'm looking for a more dynamic way of copying the sheets over.
I have come up with the following code, however it doesn't work as i hoped it might and i could really do with some help.

I have come up with the following code, but clearly it didn't work the way i hoped it would.
I always comment my code so i know what it's doing (or think i know what it's doing) so i hope that it helps explain my thought process..

Sub CopyOver()
Dim DestinationWB As Workbook
Dim LR As Long
Dim Sht As Worksheet
Dim sCurrentSheet As String

'LastRow - Start from the bottom and go up to find the last row of data
LR = Cells(Rows.Count, "A").End(xlUp).Row

'Rename the title of the workbook that's currently open to SourceWorkbook
'as the WB name wil be different every day.
ActiveWorkbook.Windows(1).Caption = "SourceWorkbook"

'This is the Workbook where i'd like the data to be copied to.
Set DestinationWB = Workbooks.Open("C:\Documents and Settings\dtayl211\Desktop\Syslog\New Folder\Syslog.xls")

'Activate the workbook with the data i want to copy over
Windows("SourceWorkbook").Activate

'Store the name of the current sheet so i can reference it against the sheet name in the Destination workbook.
sCurrentSheet = Windows("SourceWorkbook").ActiveSheet.Name

Application.ScreenUpdating = False
For Each Sht In Application.Worksheets
Sht.Activate

'Select Range from Column A1 through to Column F down to the last row
Range("A1:F" & LR).Select

'Copy the text, dont cut it.
Application.CutCopyMode = False
Selection.Copy

'Switch over to the Destination Workbook - Syslog.xls
Windows("Syslog.xls").Activate
'Activate the current sheet name found from the Source Workbook, so the WSheet is the same.
Sheets(sCurrentSheet).Activate

'tell me what sheet you think should be activated
'msgbox sCurrentSheet

'Find the last used cell and drop down one as i don't want to overwrite any rows.
Range("A65536").End(xlUp).Offset(1, 0).Select
'Paste in the information.
ActiveSheet.Paste

'Flip back to the Source Workbook so i can get the information from the next worksheet
Windows("SourceWorkbook").Activate
Next Sht
Application.ScreenUpdating = True
End Sub

Open in new window


I hope i've made sense and not waffled too much, i wanted to explain as best i could...

Thanks in advance..
Daz
0
Comment
Question by:vestanpance_uk
  • 4
  • 2
7 Comments
 
LVL 8

Expert Comment

by:ragnarok89
ID: 35209204
Your code seems perfect. If you're getting extra sheets when you shouldn't, can you give me an example of the name of a sheet that gets created but shouldn't, and the name of the existing sheet that should have been selected?
0
 

Author Comment

by:vestanpance_uk
ID: 35209409
Hi ragnarok89,

Thanks for your reply....
Sadly my code isn't perfect as it copies every sheet from the SourceWB  to a single Sheet in the DestinationWB which isn't what i wanted. (I don't get any extra sheets being added though.)

Basically, when the SourceWB is open i would like to copy the data from it's separate Worksheets to Worksheets of the same name in the DestinationWB.

For example.

SourceWB.Sheet1 -> Copy Sheet1 data
goto DestinationWB
DestinationWB.Sheet1 -> Check for the last row and drop down 1 -> paste data from SourceWB.Sheet1
goto SourceWB
SourceWB.Sheet2 -> Copy Sheet2 data
goto DestinationWB
DestinationWB.Sheet2 -> Check for the last row and drop down 1 -> paste data from SourceWB.Sheet2
goto SourceWB
SourceWB.Sheet3 -> Copy Sheet3 data
goto DestinationWB
etc etc.....

This goes on until all Sheets in SourceWB have been processed. There are over 80 Worksheets in the DestinationWB and generally there are 30 Worksheets in SourceWB on any given day and the Worksheet names i wish to copy are nearly always different... (as different Network Switches can have issues)

My original macro hard coded the names of the worksheets and it works fine, but as i said before i have found newer switches making their way into the Syslog list and they're getting missed off the DestinationWB (Central Workbook)

Thanks
Daz
0
 
LVL 39

Expert Comment

by:nutsch
ID: 35211546
Daz, you want something like this?

Sub CopyOver()
Dim DestinationWB As Workbook, OriginWB As Workbook
Dim LR As Long
Dim sht As Worksheet
Dim sCurrentSheet As String

'assign active origin workbook to variable
Set OriginWB = ActiveWorkbook

'This is the Workbook where i'd like the data to be copied to.
Set DestinationWB = Workbooks.Open("C:\Documents and Settings\dtayl211\Desktop\Syslog\New Folder\Syslog.xls")

Application.ScreenUpdating = False

For Each sht In OriginWB.Worksheets
    If SheetExistsInWorkbook(sht.Name, DestinationWB) Then
        sht.Range("A1:F" & sht.Cells(Rows.Count, 1).End(xlUp).Row).Copy _
            DestinationWB.Sheets(sht.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Else
        sht.Copy After:=DestinationWB.Sheets(DestinationWB.Sheets.Count)
    End If
Next sht

Application.ScreenUpdating = True
End Sub


Function SheetExistsInDestinationWorkbook(strShtName As String, wb As Workbook) As Boolean
Dim sht As Worksheet

For Each sht In wb.Sheets
    If sht.Name = strShtName Then
        SheetExistsInDestinationWorkbook = True
        Exit Function
    End If
Next

SheetExistsInDestinationWorkbook = False

End Function

Open in new window





Thomas
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 39

Expert Comment

by:nutsch
ID: 35211577
Sorry, the name of the function should be updated. Here is the full code you should use
Sub CopyOver()
Dim DestinationWB As Workbook, OriginWB As Workbook
Dim LR As Long
Dim sht As Worksheet
Dim sCurrentSheet As String

'assign active origin workbook to variable
Set OriginWB = ActiveWorkbook

'This is the Workbook where i'd like the data to be copied to.
Set DestinationWB = Workbooks("Book5") 'Workbooks.Open("C:\Documents and Settings\dtayl211\Desktop\Syslog\New Folder\Syslog.xls")

Application.ScreenUpdating = False

For Each sht In OriginWB.Worksheets
    If SheetExistsInWorkbook(sht.Name, DestinationWB) Then
        sht.Range("A1:F" & sht.Cells(Rows.Count, 1).End(xlUp).Row).Copy _
            DestinationWB.Sheets(sht.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Else
        sht.Copy After:=DestinationWB.Sheets(DestinationWB.Sheets.Count)
    End If
Next sht

Application.ScreenUpdating = True
End Sub

Function SheetExistsInWorkbook(strShtName As String, wb As Workbook) As Boolean
Dim sht As Worksheet

For Each sht In wb.Sheets
    If sht.Name = strShtName Then
        SheetExistsInWorkbook = True
        Exit Function
    End If
Next

SheetExistsInWorkbook = False

End Function

Open in new window

0
 
LVL 39

Accepted Solution

by:
nutsch earned 500 total points
ID: 35211625
Third (and hopefully last) version, removing my testing code on line 11.

Sub CopyOver()
Dim DestinationWB As Workbook, OriginWB As Workbook
Dim LR As Long
Dim sht As Worksheet
Dim sCurrentSheet As String

'assign active origin workbook to variable
Set OriginWB = ActiveWorkbook

'This is the Workbook where i'd like the data to be copied to.
Set DestinationWB = Workbooks.Open("C:\Documents and Settings\dtayl211\Desktop\Syslog\New Folder\Syslog.xls")

Application.ScreenUpdating = False

For Each sht In OriginWB.Worksheets
    If SheetExistsInWorkbook(sht.Name, DestinationWB) Then
        sht.Range("A1:F" & sht.Cells(Rows.Count, 1).End(xlUp).Row).Copy _
            DestinationWB.Sheets(sht.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Else
        sht.Copy After:=DestinationWB.Sheets(DestinationWB.Sheets.Count)
    End If
Next sht

Application.ScreenUpdating = True
End Sub

Function SheetExistsInWorkbook(strShtName As String, wb As Workbook) As Boolean
Dim sht As Worksheet

For Each sht In wb.Sheets
    If sht.Name = strShtName Then
        SheetExistsInWorkbook = True
        Exit Function
    End If
Next

SheetExistsInWorkbook = False

End Function

Open in new window

0
 

Author Closing Comment

by:vestanpance_uk
ID: 35211865
Thanks a lot Thomas, that's twice you've come to my rescue!  That's absolutely spot on, exactly what i wanted it to do....

Thanks so much!
Daz
0
 
LVL 39

Expert Comment

by:nutsch
ID: 35211907
Glad to help. Sorry for the multiple posts.

Thomas
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Outlook Free & Paid Tools
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now