Macro worts in workbook but not from Personal.xls

[Nev]

Hi there

With help from community I have a great macro. Trouble is that this section
will run in its own workbook but not when its in Personal.xls

Sub Copy_to_new_Workbook()
Dim SourceRange As Range
Dim DestRange As Range
Dim DestWB As Workbook
Dim DestSh As Worksheet
Dim Lr As Long

Macro then runs fine until after the option to save from here on

Application.Dialogs(xlDialogSaveAs).Show

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Change the file name (2*) and the path/file name to your file
If bIsBookOpen_RB("Master Copy.xls") Then
Set DestWB = Workbooks("Master Copy.xls")
Else
Set DestWB = Workbooks.Open("c:\block management\Master Copy.xls")
End If

'Change the Source Sheet and range
Set SourceRange = ThisWorkbook.Sheets("addresses").Range("b1:t500")
'Change the sheet name of the database workbook
Set DestSh = DestWB.Worksheets("addresses")

Set DestRange = DestSh.Range("b1:t500")

On Error Resume Next
For Each wks In Worksheets
wks.Unprotect Password:="nev"
Next wks

Then it works OK. It just will not copy the data from Source to Destination
sheets

Can anyone out there help? I have 80 workbooks to run from Personal!

Thanks in advance

Nev

 

[Bob Umlas]

Most likely cuplrit is the use of "Thisworkbook" which now refers to your
personal.xls and which probably doesn't have a sheet named "Addresses"!
Change thisworkbook to Activeworkbook and all should be OK
Bob Umlas
Excel MVP

 

[Dave Peterson]

And to add to Bob's advice...

This line (after Bob's suggested change)
'Change the Source Sheet and range
Set SourceRange = Activeworkbook.Sheets("addresses").Range("b1:t500")

Will refer to the activeworkbook. And if you just opened that "Master Copy.xls"
file, there's a good chance that "Master Copy.xls" is the activeworkbook.

I'd move that line before the bisbookopen() line:

....

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Change the Source Sheet and range
Set SourceRange = Activeworkbook.Sheets("addresses").Range("b1:t500")

'Change the file name (2*) and the path/file name to your file
If bIsBookOpen_RB("Master Copy.xls") Then
Set DestWB = Workbooks("Master Copy.xls")
Else
Set DestWB = Workbooks.Open("c:\block management\Master Copy.xls")
End If

'Change the sheet name of the database workbook
Set DestSh = DestWB.Worksheets("addresses")

Set DestRange = DestSh.Range("b1:t500")

.....

 

[Nev]

Dave (and Bob)

Guys - this is great! Only one thing, it is copying "si" from newly opened
Master Copy to "ys" in the same workbook, not from the original workbook. I
need to run transfer from original of "addresses" to Master then back to
original and transfer original "si" to Master "ys"

Can you help?

thanks

Nev

 

[Dave Peterson]

I don't understand.

But maybe it's as simple as swapping the source range and the destination range.

If that doesn't help, then post your current code and explain what "si" and "ys"
are.

 

[Nev]

Hello Dave

My goal is:-
Start workbook (which is variable) is , say Bath Road. I want to copy 2
worksheets from that one called "addresses" and "si" to a new document which
is always called "Master Copy". Addresses is copying correctly but it seems
that using the code I have, after addresses has been copied it does not
revert to the origibal document, it is staying in "Master Copy" and I do not
know how to correct this.

The code works perfectly fine if it is a macro within the start workbook, it
is when in Personal.xls that it fails to run.

Does this help you to help me?

If you need code or copies of the start and Master Copy workbooks, can send
them - where to?

Thanks

Nev

 

[Dave Peterson]

So you expect the "bath road" workbook to be open and to be the activeworkbook,
too. Right?

Sub Copy_to_new_Workbook()

dim ActWkbk as workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim DestWB As Workbook
Dim MstrWkbkWasOpen as boolean

Set Actwkbk = activeworkbook

If bIsBookOpen_RB("Master Copy.xls") Then
mstrwkbkwasopen = true
Set DestWB = Workbooks("Master Copy.xls")
Else
mstrwkbkwasopen = false
Set DestWB = Workbooks.Open("c:\block management\Master Copy.xls")
End If

'do the first copy
Set SourceRange = actwkbk.Sheets("addresses").Range("b1:t500")
Set destrange = DestWB.Worksheets("addresses").Range("b1")

sourcerange.copy _
destination:=destrange

'==========

'do the second copy
Set SourceRange = actwkbk.Sheets("si").Range("x99:z10000")
Set destrange = DestWB.Worksheets("si").Range("x99")

sourcerange.copy _
destination:=destrange

destwb.save 'save it?

if mstrwkbkwasopen then
'leave it open
else
destwb.close
end if

actwkbk.activate 'go back to original workbook.

End sub


I saved the master workbook in code. If you delete that line, then don't close
the workbook at the end.


This compiled (with the exception of bIsBookOpen_RB), but I didn't test it.

And I had no idea how the stuff on "si" was copy|pasted.

Hello Dave

My goal is:-
Start workbook (which is variable) is , say Bath Road. I want to copy 2
worksheets from that one called "addresses" and "si" to a new document which
is always called "Master Copy". Addresses is copying correctly but it seems
that using the code I have, after addresses has been copied it does not
revert to the origibal document, it is staying in "Master Copy" and I do not
know how to correct this.

The code works perfectly fine if it is a macro within the start workbook, it
is when in Personal.xls that it fails to run.

Does this help you to help me?

If you need code or copies of the start and Master Copy workbooks, can send
them - where to?

Thanks

Nev

 

[Nev]

Dave

What can I say - made a few tweaks and it does just what I want - a thousand
thanks

Nev

 

[Dave Peterson]

Glad you got it working.

Dave

What can I say - made a few tweaks and it does just what I want - a thousand
thanks

Nev

 

[Nev]

Hi Dave

Had everything working great! Made an error of judgement and got Vista.

All the macros run OK when in a single workbook but the macro copying one to
the other does nothing. It runs OK in XP and Office 2007 but seems not in
Vista and Office 2007

This is the code
Sub Copy_to_new_Workbook()
Dim ActWkbk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim DestWB As Workbook
Dim MstrWkbkWasOpen As Boolean
Set ActWkbk = ActiveWorkbook

Then runs OK and opens "Master copy"

On Error Resume Next
For Each sh In Worksheets
sh.Unprotect Password:="nev"
Next sh

If bIsBookOpen_RB("Master Copy.xls") Then
MstrWkbkWasOpen = True
Set DestWB = Workbooks("Master Copy.xls")
Else
MstrWkbkWasOpen = False
Set DestWB = Workbooks.Open("c:\block management\Master Copy.xls")
End If

'do the first copy
Set SourceRange = ActWkbk.Sheets("addresses").Range("b4:t500")
Set DestRange = DestWB.Worksheets("addresses").Range("b4:t500")

SourceRange.Copy _
Destination:=DestRange

'==========

'do the second copy
Set SourceRange = ActWkbk.Sheets("si").Range("b1:t500")
Set DestRange = DestWB.Worksheets("ys").Range("b1:t500")

SourceRange.Copy
DestRange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False

For Each sh In ActiveWorkbook.Worksheets
On Error Resume Next
sh.Name = sh.Cells(1, 1).Value
If Err.Number <> 0 Then
Err.Clear
End If
On Error GoTo 0
Next sh

For sh = 1 To Sheets.Count
If Sheets(sh).Name = "Sheet" Then GoTo Resume_Next
Sheets(sh).Activate
LastRowOfData = Cells(Rows.Count, "a").End(xlUp).Row
For X = 1 To LastRowOfData
If Cells(X, "a").Value = "0" Then
Cells(X, "a").EntireRow.Clear
Cells(X, "a").EntireRow.Hidden = True
End If
Resume_Next:
Next
Next


On Error Resume Next
For Each sh In Worksheets
wks.Protect Password:="nev"
Next sh

Dim cell As Range

On Error Resume Next
For Each sh In Worksheets
sh.Unprotect Password:="nev"
Next sh

Application.GoTo Reference:=Range("'addresses'" & "!a1")

Cells.Select
Range("K4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False


On Error Resume Next
For Each wks In Worksheets
wks.Protect Password:="nev"
Next wks

Application.Dialogs(xlDialogSaveAs).Show

End Sub

I have deleted parts of the macro that I can build back in to keep it brief.

Please - can you help?

Thanks

Nev

 

[Dave Peterson]

What goes wrong?

I don't see anything that would depend on the version of windows--or even the
version of excel.

I'd step through the code to see where things broke.

Hi Dave

Had everything working great! Made an error of judgement and got Vista.

All the macros run OK when in a single workbook but the macro copying one to
the other does nothing. It runs OK in XP and Office 2007 but seems not in
Vista and Office 2007

This is the code
Sub Copy_to_new_Workbook()
Dim ActWkbk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim DestWB As Workbook
Dim MstrWkbkWasOpen As Boolean
Set ActWkbk = ActiveWorkbook

Then runs OK and opens "Master copy"

On Error Resume Next
For Each sh In Worksheets
sh.Unprotect Password:="nev"
Next sh

If bIsBookOpen_RB("Master Copy.xls") Then
MstrWkbkWasOpen = True
Set DestWB = Workbooks("Master Copy.xls")
Else
MstrWkbkWasOpen = False
Set DestWB = Workbooks.Open("c:\block management\Master Copy.xls")
End If

'do the first copy
Set SourceRange = ActWkbk.Sheets("addresses").Range("b4:t500")
Set DestRange = DestWB.Worksheets("addresses").Range("b4:t500")

SourceRange.Copy _
Destination:=DestRange

'==========

'do the second copy
Set SourceRange = ActWkbk.Sheets("si").Range("b1:t500")
Set DestRange = DestWB.Worksheets("ys").Range("b1:t500")

SourceRange.Copy
DestRange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False

For Each sh In ActiveWorkbook.Worksheets
On Error Resume Next
sh.Name = sh.Cells(1, 1).Value
If Err.Number <> 0 Then
Err.Clear
End If
On Error GoTo 0
Next sh

For sh = 1 To Sheets.Count
If Sheets(sh).Name = "Sheet" Then GoTo Resume_Next
Sheets(sh).Activate
LastRowOfData = Cells(Rows.Count, "a").End(xlUp).Row
For X = 1 To LastRowOfData
If Cells(X, "a").Value = "0" Then
Cells(X, "a").EntireRow.Clear
Cells(X, "a").EntireRow.Hidden = True
End If
Resume_Next:
Next
Next

On Error Resume Next
For Each sh In Worksheets
wks.Protect Password:="nev"
Next sh

Dim cell As Range

On Error Resume Next
For Each sh In Worksheets
sh.Unprotect Password:="nev"
Next sh

Application.GoTo Reference:=Range("'addresses'" & "!a1")

Cells.Select
Range("K4").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False


On Error Resume Next
For Each wks In Worksheets
wks.Protect Password:="nev"
Next wks

Application.Dialogs(xlDialogSaveAs).Show

End Sub

I have deleted parts of the macro that I can build back in to keep it brief.

Please - can you help?

Thanks

Nev

 

[Nev]

Hi Dave

thanks - I am afraid that I am not skilled at VBA and have managed to string
things together from the community.

Everything seems to run fine until "do the first copy". It does not copy
and if I pull the copying part out it still does nothing. I have tried it on
my lap top with vista and office 2007 and same thing happens.

Nev

 

[Dave Peterson]

This set of lines:

On Error Resume Next
For Each sh In Worksheets
sh.Unprotect Password:="nev"
Next sh

Turns error checking off. But I don't see where you turn it back on.

Try

On Error Resume Next
For Each sh In Worksheets
sh.Unprotect Password:="nev"
Next sh
One Error goto 0

And maybe the resulting error message will give a clue. There are a lot of
things that could have gone wrong (and that were ignored) because of that
setting.

 

[Nev]

Hi Dave

Took your earlier advice - I took everything out apart from one section - it
worked so gradually put everything back - hey presto now works! Very
strange. It also works on XP so there must be something hidden which affects
it with Vista.

thanks for all the help.

Nev