#1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 8
Default Macro Help

Hello all. So this is what I'm trying to do. I have an excel
spreadsheet that I export from a program, creating a text file. This
file I have to open in excel, and then copy and paste sections into a
worksheet that contains three sheets. In this second spreadsheet,
there is a macro that runs certain checks and then makes the file
into
an XML.
What I am attempting to do is create a macro that will look in a
folder on my desktop that contains around 10 of these exported text
files, run it through the copy and paste macro that i have created,
and then run the macro in the second spreadsheet. I would then like
to save both the second spreadsheet I've pasted on and the XML file.

So what I have done so far is listed below. I managed to make a
window pop up to select the files i want to run through the macro.
What I would actually prefer to do is just look in a folder and run
ALL files in there that are excel spreadsheets. I then run the copy
paste macro and select the XML macro to run and then things just sort
of stop. As i run the macro, it stops to prompt me to name the XML
file. What I would love to do (and have attempted) is to name the
file automatically a cell from the Second Workbook. I cant figure out
how to get around this propmt and name it automatically.

I would really appreciate if someone would look at what I've done.
Im
really new at this and im sure theres alot of cleaning up to do. I
may
have made this way more complicated then it needs to be. Thanks in
advance for your help!

Sub CopyPaste2()
Application.ScreenUpdating = False
Dim wbCurrent As Workbook
files_to_open = _
Application.GetOpenFilename("Excel files (*.xls), _*.xls", , , ,
True)
If Not IsArray(files_to_open) Then
MsgBox "Nothing selected"
Exit Sub
Else
For i = LBound(files_to_open) To UBound(files_to_open)
Set wbCurrent = Workbooks.Open(files_to_open(i))
Application.StatusBar = "Processing " & files_to_open(i)
FinalCopy wbCurrent

FinalCopy(myWB As Workbook)
Range("B18").Select
Application.CutCopyMode = False
Selection.Cut Destination:=Range("C18")
Range("B28").Select
Selection.Cut Destination:=Range("C28")
Range("D18").Select
ActiveCell.FormulaR1C1 = "=CLEAN(RC[-1])"
Range("D28").Select
ActiveCell.FormulaR1C1 = "=CLEAN(RC[-1])"
Range("D18").Select
Selection.Copy
Range("B18").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("D28").Select
Application.CutCopyMode = False
Selection.Copy
Range("B28").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Rows("1:1").Select
Selection.Delete Shift:=xlUp
ChDir "C:\Documents and Settings\Owner\Desktop"
Workbooks.Open Filename:= _
"C:\Documents and Settings\Owner\Desktop\Second
Worksheet.xls"

ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Demographic Info").Select
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
myWB.Activate
Range("B1:B5").Select
Selection.Copy
Windows("Second Worksheet.xls").Activate
Range("B2").Select
ActiveSheet.Paste
myWB.Activate
Range("B8:B19").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Second Worksheet.xls").Activate
Range("B10").Select
ActiveSheet.Paste
myWB.Activate
ActiveWindow.SmallScroll Down:=18
Range("B23:B30").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Second Worksheet").Activate
Range("B25").Select
ActiveSheet.Paste
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 12
Sheets("Sheet 2").Select
myWB.Activate
Range("B34:B44").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Second Worksheet.xls").Activate
Range("B3").Select
ActiveSheet.Paste
myWB.Activate
ActiveWindow.SmallScroll Down:=12
Range("B49:H49").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Second Worksheet.xls").Activate
Range("A18").Select
ActiveSheet.Paste
Sheets("Sheet 3").Select
myWB.Activate
Rows("51:170").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("A51"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
Range("A51:O86").Select
Selection.Copy
Windows("Second Worksheet.xls").Activate
Range("A5").Select
ActiveSheet.Paste

myWB.Activate
Range("B49").Select
Selection.Copy

Windows("Second Worksheet.xls").Activate
ActiveWindow.SmallScroll ToRight:=4
Sheets("Sheet 3").Select
ActiveWindow.SmallScroll ToRight:=3
Application.Run "MakeXML"

NewFilename = Left(files_to_open(i), Len(files_to_open(i)) - 4) _
& " - Testing - please delete.xls"
wbCurrent.SaveAs NewFilename
wbCurrent.Close
Next i
End If
Set wbCurrent = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox UBound(files_to_open) - LBound(files_to_open) + _
1 & " files processed (hopefully)."
End Function

Const fPath As String = "C:\Documents and Settings\Desktop\"
Dim fName As String
Dim myFileName As String

myFileName = "EXCEL" & Sheets("Sheet 2").Range("A18") & ".xls"
fName = fPath & myFileName

ActiveSheet.SaveAs Filename = fName
MsgBox "File Saved to " & fName

End Function

THANKS!

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro Help Needed - Excel 2007 - Print Macro with Auto Sort Gavin Excel Worksheet Functions 0 May 17th 07 01:20 PM
Need syntax for RUNning a Word macro with an argument, called from an Excel macro Steve[_84_] Excel Programming 3 July 6th 06 07:42 PM
how to count/sum by function/macro to get the number of record to do copy/paste in macro tango Excel Programming 1 October 15th 04 01:16 PM
macro to delete entire rows when column A is blank ...a quick macro vikram Excel Programming 4 May 3rd 04 08:45 PM
Start Macro / Stop Macro / Restart Macro Pete[_13_] Excel Programming 2 November 21st 03 05:04 PM


All times are GMT +1. The time now is 02:46 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"