Thread: Macro possible?
View Single Post
  #2  
Old June 6th, 2004, 08:00 AM
Cuda
external usenet poster
 
Posts: n/a
Default Macro possible?

I think the following sub pasted in a module in vba should do what you want.
You can run it from a button on the main sheet you're posting from or run if
from ToolsMacroMacrosPasteClient. I haven't tested it extensively so use
it at your own risk.

Sub PasteClient()

Dim ClientFile As String 'Holds client's file name

'In case of an error this will handle it gracefully and give you
'some information.
On Error GoTo ErrorHandler

'Turn screen updating off. You won't see the client file being updated.
Application.ScreenUpdating = False

'Make sure proper worksheet is active. This assumes the
'worksheet is named Sheet1. Adjust as required.
If ActiveCell.Worksheet.Name "Sheet1" Then Exit Sub

'Make sure a cell in column A is selected. This assumes the client
'account number is in column A. Adjust as required.
If Left(ActiveCell.Address(False, False), 1) "A" Then Exit Sub

'Get the client's file name.
ClientFile = ActiveCell.Text & ".xls"

'Select the client data to be posted. This assumes client data
'spans 6 cells
ActiveCell.Range("A1:F1").Copy

'Open the client file for posting. This assumes the path to the
'1000 client files is in the path "C:\Client\". Adjust as required.
Workbooks.Open Filename:="C:\Client\" & ClientFile

'Assumes the client data will be posted on a worksheet named
'"Sheet1" in the client file just opened. Adjust as required.
Sheets("Sheet1").Select

'Position the cursor in the first cell in the client file. Assumes
'client data will be posted beginning in column A. Adjust as required.
Range("A1").Select

'Find the first empty cell where the current data can be posted.
Do While ActiveCell.Text ""
ActiveCell.Offset(1, 0).Select
'Assumes your Excel sheets have 65536 rows. This prevents running
'off the bottom of the worksheet and causing an error. Adjust as
required.
If ActiveCell.Row 65536 Then Exit Sub
Loop

'Paste the client data into the client worksheet file.
ActiveSheet.Paste

'Cancels the copy mode. Client data can no longer be pasted any where else.
Application.CutCopyMode = False

'Save the client workbook and the posted data just pasted.
ActiveWorkbook.Save

'Close the client workbook.
ActiveWindow.Close

'Turn screen updating back on.
Application.ScreenUpdating = True

Exit Sub

ErrorHandler:

Select Case Err.Number
Case Is = 1004 'Client file already open or client file does not exist.
There may be
'other things that will cause this error.
'There are several ways to handle this error. I chose to inform the user
then exit
'this sub without any alteration to the client file.
MsgBox "There is a problem with client file: " & ClientFile, vbOKOnly +
vbInformation, "An error has occurred ..."
Case Else 'Catches any unexpected errors.
MsgBox "Error number " & Err.Number & " has occurred", vbOKOnly +
vbInformation, "An error has occurred ..."
End Select


End Sub

"Nimit Mehta" wrote in message
...
I have a folder with about 1000 workbooks.
All contain data of conference customers.
All customers have unique account number.

Account Date TIme Country Rate Minutes
34254 26-Jun 4:45 PM USA 2.5 56

I want to have a macro that will open workbook "34256.xls"
and paste the date,time,country,rate and minutes as above
in the empty cells available, save "34256.xls" and exit
the file.
Is that possible?