Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default converting workbooks to worksheets

I am trying to convert this file to create new worksheets within one
workbook instead of the origional multiple workbooks. I can import my
data and create the first report fine, I just can't get back into the
loop to create the second file. My syntax errors are on my
worksheets(send).activate and worksheets(home).activate. I would
really appreciate a few suggestions. thanks.

Global worksheets As Worksheet
Global home As String
Global send As String
Global csthold As String
Global sthold As String
Global tdte As String
Global fdte As String


Sub auto()
Set worksheets = Sheets.Add

' assigns the name of the worksheet on top to home
home = ActiveSheet.Name
' selects all the cells, delete's all the values and activates
cell A1
Cells.Select
Selection.Delete
Range("A1").Select




With ActiveSheet.QueryTables.Add(Connection:=Array(Arra y( _
"ODBC;DRIVER={Client Access ODBC Driver
(32-bit)};SYSTEM=ACIP400A;CMT=0;DBQ=brimiz;NAM=;DFT=0; DSP=0;TFT=0;TSP=0;DEC=0;XDYNAMIC=0;RECB"
_
), Array( _
"LOCK=0;BLOCKSIZE=8;SCROLLABLE=0;TRANSLATE=0;LAZYC LOSE=0;LIBVIEW=0;REMARKS=0;CONNTYPE=0;SORTTYPE=0;L ANGUAGEID=ENU;SORTWEIGHT=0;P"
_
), Array("REFETCH=0;MGDSN=0;")), Destination:=Range("A1"))
.Sql = Array( _
"SELECT OPP6249.CSTNAM, OPP6249.STATE, OPP6249.BRANCH,
OPP6249.BRANCHID, OPP6249.JAN, OPP6249.FEB, OPP6249.MAR, OPP6249.APR,
OPP6249.MAY, OPP6249.JUN, OPP6249.JUL, OPP6249.AUG, OPP6249.SEP,
OPP6249.OCT" _
, _
", OPP6249.NOV, OPP6249.DEC, OPP6249.YTD, OPP6249.LY,
OPP6249.BEGDTE, OPP6249.ENDDTE" & Chr(13) & "" & Chr(10) & "FROM
ACIP400A.CCSDTA.OPP6249 OPP6249" _
)
.FieldNames = True
.RefreshStyle = xlInsertDeleteCells
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = False
.HasAutoFormat = True
.BackgroundQuery = True
.TablesOnlyFromHTML = True
.Refresh BackgroundQuery:=False
.SavePassword = True
.SaveData = True
End With


Sheets.Add
send = ActiveSheet.Name
worksheets(home).Activate
csthold = Range("A2").Value
fdte = Mid(Range("S2"), 5, 2) + "/" + Right(Range("S2"), 2) + "/"
+ Left(Range("S2"), 4)
tdte = Mid(Range("T2"), 5, 2) + "/" + Right(Range("T2"), 2) + "/"
+ Left(Range("T2"), 4)
Range("A2").Select
print_header
worksheets(home).Activate

run

worksheets(home).Activate
Cells.Select
Selection.Delete
Range("A1").Select

worksheets(send).Activate


End Sub

Sub run()
Dim row As String
Dim row2 As String
Dim branch As String
Dim branchid As String
Dim jan As String
Dim feb As String
Dim mar As String
Dim apr As String
Dim may As String
Dim jun As String
Dim jul As String
Dim aug As String
Dim sep As String
Dim oct As String
Dim nov As String
Dim dec As String
Dim ytd As String
Dim ly As String

While ActiveCell.Value < ""
row = ActiveCell.row
If Range("A" + row).Value < csthold Then
csthold = Range("A" + row).Value
sthold = Range("B" + row).Value
MsgBox (send)
worksheets(send).Activate
Cells.Select
Selection.Columns.AutoFit
Columns("Q:Q").Select
Selection.ColumnWidth = 6.5
Range("A1").Select
worksheets(home).Activate
Sheets.Add
send = ActiveWindow.Caption
worksheets(home).Activate
print_header
new_state
ElseIf Range("B" + row).Value < sthold Then
sthold = Range("B" + row).Value
new_state
GoTo w
Else
branch = Range("C" + row).Value
branchid = Range("D" + row).Value
jan = Range("E" + row).Value
feb = Range("F" + row).Value
mar = Range("G" + row).Value
apr = Range("H" + row).Value
may = Range("I" + row).Value
jun = Range("J" + row).Value
jul = Range("K" + row).Value
aug = Range("L" + row).Value
sep = Range("M" + row).Value
oct = Range("N" + row).Value
nov = Range("O" + row).Value
dec = Range("P" + row).Value
ytd = Range("Q" + row).Value
ly = Range("R" + row).Value


worksheets(send).Activate
row2 = ActiveCell.row
Range("A" + row2).Value = branch
Range("B" + row2).Value = branchid
Range("C" + row2).Value = jan
Range("D" + row2).Value = feb
Range("E" + row2).Value = mar
Range("F" + row2).Value = apr
Range("G" + row2).Value = may
Range("H" + row2).Value = jun
Range("I" + row2).Value = jul
Range("J" + row2).Value = aug
Range("K" + row2).Value = sep
Range("L" + row2).Value = oct
Range("M" + row2).Value = nov
Range("N" + row2).Value = dec
Range("O" + row2).Value = ytd
Range("P" + row2).Value = ly

row2 = row2 + 1
Range("A" + row2).Select

worksheets(home).Activate
ActiveCell.Offset(1, 0).Select

End If


w:
Wend

worksheets(send).Activate
Cells.Select
Selection.Columns.AutoFit
Columns("Q:Q").Select
Selection.ColumnWidth = 6.5
Range("A1").Select

End Sub
Sub print_header()

Dim dte As String
Dim tme As String
dte = Date
tme = Time

worksheets(send).Activate
ActiveCell.FormulaR1C1 = "DATE: " + dte
Range("A2").Select
ActiveCell.FormulaR1C1 = "TIME: " + tme
Range("A3").Select
ActiveCell.FormulaR1C1 = csthold
Range("A5").Select
ActiveCell.FormulaR1C1 = "BRANCH"
Range("A6").Select
Columns("A:A").ColumnWidth = 21
Range("B5").Select
ActiveCell.FormulaR1C1 = "ID"
Columns("B:B").Select
Selection.ColumnWidth = 10
Columns("O:O").Select
Selection.ColumnWidth = 9.5
Columns("P:P").Select
Selection.ColumnWidth = 6.5
Columns("Q:Q").Select
Selection.ColumnWidth = 6.5
Columns("R:R").Select
Selection.ColumnWidth = 6.5
Range("C5").Select
ActiveCell.FormulaR1C1 = "JAN"
Range("D5").Select
ActiveCell.FormulaR1C1 = "FEB"
Range("E5").Select
ActiveCell.FormulaR1C1 = "MAR"
Range("F5").Select
ActiveCell.FormulaR1C1 = "APR"
Range("G5").Select
ActiveCell.FormulaR1C1 = "MAY"
Range("H5").Select
ActiveCell.FormulaR1C1 = "JUN"
Range("I5").Select
ActiveCell.FormulaR1C1 = "JUL"
Range("J5").Select
ActiveCell.FormulaR1C1 = "AUG"
Range("K5").Select
ActiveCell.FormulaR1C1 = "SEP"
Range("L5").Select
ActiveCell.FormulaR1C1 = "OCT"
Range("M5").Select
ActiveCell.FormulaR1C1 = "NOV"
Range("N5").Select
ActiveCell.FormulaR1C1 = "DEC"
Range("O5").Select
ActiveCell.FormulaR1C1 = Str(Year(Date)) + " YTD"
Range("P5").Select
ActiveCell.FormulaR1C1 = Str(Year(Date) - 1) + " YTD"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "PROGRAM: OPB6249"
Range("Q1").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("B1").Select
ActiveCell.FormulaR1C1 = "American Ductile Iron Pipe"
Range("B2").Select
ActiveCell.FormulaR1C1 = "DISTRIBUTOR SALES FOR CORPORATE GROUPS"
Range("B3").Select
ActiveCell.FormulaR1C1 = fdte + " THROUGH " + tdte
Columns("B:B").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With

Columns("C:P").Select
Selection.NumberFormat = "#,##0"

Range("B1:N3").Select
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlBottom
End With
Range("A1").Select
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$6"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.2)
.RightMargin = Application.InchesToPoints(0.2)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 80
End With

Range("A5:R5").Select
With Selection
.HorizontalAlignment = xlCenter
End With


Range("A5").Select

End Sub

Sub new_state()
Dim rw As String

worksheets(send).Activate
rw = ActiveCell.row + 2
Range("A" + rw).Select
ActiveCell.Value = sthold
ActiveCell.Offset(1, 0).Select
worksheets(home).Activate
End Sub
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
issues when converting excel 2003 workbooks to 2007 RonP Excel Discussion (Misc queries) 1 June 26th 08 08:19 PM
converting 2002 workbooks to 2007 MJY Excel Discussion (Misc queries) 1 January 27th 08 08:41 PM
Copy/ move selected data from workbooks to seperate worksheets or workbooks Positive Excel Worksheet Functions 1 August 30th 07 04:54 PM
Worksheets and Workbooks Tia Excel Discussion (Misc queries) 1 June 9th 05 11:33 PM
Converting worksheets to workbooks. Is there an easy way? Jim Excel Discussion (Misc queries) 1 March 22nd 05 02:31 PM


All times are GMT +1. The time now is 12:27 PM.

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"