[Irish_Dave]

Hi there eveyone. Hope ur all ok and ready for xmas.
I have recently devised a little program for work.
This program simply works over a 12 week cycle. The program identifies what week it is between 1 - 12, and then what day it is, and wether the shift is an AM shift or a PM shift.
Once this has been established it finds the correct Logsheet (Excel sheet) for that day and launches it.

The problem I have is that I have 144 excel sheets that all need modifiying if a change is made.
To get around this problem I have an idea to simply used one modified logsheet/excel sheet and use that as a master copy so to speak.

So within VB6 I want to select the master excel sheet and run a vb6 program that will take the contents of a selected sheet from the logsheet and copy that info to the master excel sheet.

Once the data has been taken then delete the old logsheet
Put this data into the mastercopy then rename the master excel sheet and then save it.

I want to do this by not opening either excel workbooks.
Then loop until all 144 excel sheets have been modified.

I have some code that will take the contents of a closed book and place that data into a seperate open workbook.

'////////////////////////////////////////////////////////////////////////////////

Private Sub Workbook_BeforeSave (ByVal SaveAsUI As  Boolean,Cancel As Boolean)

'Put in the UsedRange Address of Sheet1 Book1.xls (this workbook)

	Sheet2.Cells(1, 1) = Sheet1.UsedRange.Address

End Sub


Sub PullInSheet1()

'''''''''''''''''''''''''''''''

'Pulls in all data from sheet1 of a closed workbook.

''''''''''''''''''''''''''''''''
Dim AreaAddress As String

'Clear sheet ready for new data

Sheet1.UsedRange.Clear

'Reference the UsedRange Address of Sheet1 in the closed Workbook.

Sheet1.Cells(1, 1) = "= 'C:\MyDocuments\"& "[Book1.xls]Sheet2'!RC"

'Pass the area Address to a String

AreaAddress = Sheet1.Cells(1, 1)

With Sheet1.Range(AreaAddress)

	 'If the cell in Sheet1 of the closed workbook is not empty the pull in it's content, else put in an Error.

  .FormulaR1C1 = "=IF('C:\My Documents\"[Book1.xls]Sheet1'!RC="""",NA(),'C:\My Documents\"[Book1.xls]Sheet1'!RC)"

	'Delete all Error cells
	On Error Resume Next

	   .SpecialCells(xlCellTypeFormulas, xlErrors).Clear

	On Error GoTo 0

	'Change all formulas to Values only

	.Value = .Value
	
	 End With

End Sub

Private Sub Workbook_Open()

Run "PullInSheet1"

End Sub

The code works but not like I would like. I dont want to open 144 excel sheets to copy data from one book to another. I thought that maybe if I leave out the Open from Workbooks.Open (C:\My Documents\"Book1.xls")But that didn't work.

If anybody can may be give any pointers in the right direction, or even clearify wether this can actually be done.

Any information would be really greatful.
Merry xmas everyone.

Admin Edit: Please use code tags when posting your code. Code tags are used like so => Thanks, PsychoCoder

[June7]

Did not work in what way? Any error messages, no action?

My experience is that the workbook has to be open but not necessarily visible.

Post code between code tags. Use the CODE button at top of post editor window.

This post has been edited by June7: 11 December 2009 - 12:59 PM

[PsychoCoder]

Are you receiving any errors? Does this code not work that way you intended it? When asking for help there are a couple items that are vital in order for someone to properly help you:

• Post the code you're having problems with
  
• Post the exact error you're receiving, if you are receiving one
  
• If no error explain what the code is doing versus what you want it to do
  
• Post your question in the body of your post, not the description field

[Irish_Dave]

June7, on 11 Dec, 2009 - 11:57 AM, said:

Did not work in what way? Any error messages, no action?

My experience is that the workbook has to be open but not necessarily visible.

Post code between code tags. Use the CODE button at top of post editor window.

Hi June7, the code I posted does actually work, so there wasn't any error so to speak. I was trying to minipulate the code because it doesn't suite exactly what I am after. The code I have posted works only when I open the workbook, which is not what I want.
Thanks for your comments, and I will try what you said and Open the Workbook, but not make it visible when I am retriving data, then just close it when done.

Sorry about not posting between tags. Will do that next time.

Thanks again.

[Irish_Dave]

Hi PhycoCoder
Thanks for thoughs pointers I will bare them in mind for next time.
Like I said to June7, the code I posted was code that did actually work, so no real error to report. I was trying to manipulate the code because the posted code only works when the workbook is open and I dont want to open the workbook or make it visible at least.

If there is anything else that you may think of that might point me in the right direction I would be greatful.
Thanks again and take care.

[raziel_]

hello

make a tutorial or snippet dude it will give you kodus in this sections
http://www.dreaminco...showforum78.htm
for tutorial

[Irish_Dave]

Hi there everyone. I have taken on board some points that members have suggested. I have modified the code I am using. So the code now looks as follows:

Private Sub Command1_Click()

	PullInSheet1
	
End Sub
Sub PullInSheet1()

Dim ExcelApp As Object
Dim ExcelWbk As Object
Dim ExcelWkSheet As Object

	Set ExcelApp = CreateObject("Excel.Application")
	Set ExcelWbk = ExcelApp.Workbooks

	'Reference the destination book.
	
	Set ExcelWbk = ExcelApp.Workbooks.Open("C:\My Documents\OzGrid\Book2.xls")
	'Clear any cells with data.
	ExcelWbk.worksheets("Contract Areas").UsedRange.Clear
	'Reference the source book with the information you want to copy to the destination book
	With ExcelWbk.worksheets("Contract Areas").Range("$B$8:$W$107")


		.FormulaR1C1 = "=IF('C:\My Documents\OzGrid\" & "[Book1.xls]Sheet1'!RC="""",NA(),'C:\My Documents\" & "OzGrid\[Book1.xls]Sheet1'!RC)"
	  
		'The code below was to delete any errors but for some reason no longer works!!!!

		On Error Resume Next

		.SpecialCells(xlCellTypeFormulas, xlErrors).Clear

		On Error GoTo 0

		'Change all formulas to Values only

		'.Value = .Value

	End With

	ExcelWbk.SaveCopyAs "C:\My Documents\OzGrid\Book3.xls"
	'Save the book as a new book.
	ExcelWbk.Close
	'Then close the destination book, book2 in this case.
	ExcelApp.quit
End Sub

The program still doesn't work like I want. may be again I can call on the more experianced for some guideance.
I have the following probelms.

1) When the code executes I find the program hangs up when it executes the following line of code.

			   Set ExcelApp = CreateObject("Excel.Application")

It takes at least between 6-8 seconds to execute. Does anyone know why this is?

2) Is there a way round closing a workbook with out it asking me if I want to save the book first.
I am currently using the following code.

ExcelWbk.Close

3) I had some code that when it detects a blank cell or a cell with no data in it, the program throws up an error and puts a NA in the blank cell.
Then the error cells are cleared. This code no longer works but I dont know why. The following code was used.

  On Error Resume Next

		.SpecialCells(xlCellTypeFormulas, xlErrors).Clear

I am getting close, but I am really inexperianced and need some help.
If there is anyone out there who can help I would be most greatful.
Thanks a lot to thoughs who have help and commented previously and if you can help some more I would be really greatful.
Merry xmas and a happy New Year.
Oh, and I hope I have used the tags correctly this time.