PDA

View Full Version : PLEASE Help with Looping



monique
05-11-2012, 11:02 AM
I have created a workbook that contatin the sheets (DealerNameRun, SalesCal, DP, SM, and SC.
DealerNameRun contains a list A1 - Z8, I would like it to look at the first the first row (A) copy the value in A1 copy and paste to SalesCal cell F68 then copy sheet DP and SM to a new workbook,
then move to the next row in column A (A2) copy and paste to SalesCal cell F68 then copy sheet SC to the new previously, then move to next row A3 and do the same until end of data in A,
then save and close workbook,

then move to the next column (B) and copy the value in B1 copy and paste to SalesCal cell F68 then copy sheet DP and SM to a new workbook,
then move to the next row in column B (B2) copy and paste to SalesCal cell F68 then copy sheet SC to the new previously, then move to next row B3 and do the same until end of data in B,
then save and close workbook,
and repeat until Z8 (end of list)

Here is the code I have so far, please HELP!
Code below:

Option Explicit 'forces you to declare all varibles
Public wbMaster As Workbook
Public wbReport As Workbook ' holds the report workbook that we create
Public Brand As Integer 'Public db As Database 'needs to be constant throughout the project to be able to access from anywhere in the project code
Sub A_Startup()
Dim Active As String
Dim i As Integer
Dim strDir As String
Dim strLoc As String
Dim RowCount As Long ' to count records so that you can run batches of 50 or 100 etc..
Dim strSpinner As String
Dim strIndustry As String
Dim strSections As String
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lc As Long, lr As Long, MyCol As Long, MyRow As Long
Dim MyAddress As String

Application.ScreenUpdating = True 'this allows the screen not to be updated and speeds up the action of the code, you can see your code as it is working
Application.DisplayAlerts = False 'turn displays/warning off

Set ws1 = Sheets("DealerNameRun")
Set ws2 = Sheets("SalesCalc")
lc = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
For MyCol = 1 To lc
MyAddress = "F68"
lr = ws1.Cells(Rows.Count, MyCol).End(xlUp).Row
For MyRow = 1 To lr
'To put only the value of the cell to D27
ws2.Range(MyAddress).Value = ws1.Cells(MyRow, MyCol).Value
Set wbMaster = ActiveWorkbook 'set the active workbook as the master product advisor workbook
If ActiveWorkbook.Path = "C:\Users\Mizpah\Documents\Shekira\" Then
strLoc = "C:\Users\Mizpah\Documents\Shekira\Report\"
Else
strLoc = "C:\Users\Mizpah\Documents\Shekira\Report\"
End If
Set wbReport = Workbooks.Add

wbReport.Colors = wbMaster.Colors ' copies the colors
wbMaster.Worksheets("DP").Copy After:=wbReport.Worksheets(wbReport.Worksheets.Count) 'copies the pages
Cells.Copy 'COPY ALL THE CELLS IN A WORKBOOK
Cells.PasteSpecial xlPasteValues 'so it breaks the links
wbMaster.Worksheets("SM").Copy After:=wbReport.Worksheets(wbReport.Worksheets.Count) 'copies the pages
Cells.Copy 'COPY ALL THE CELLS IN A WORKBOOK
Cells.PasteSpecial xlPasteValues 'so it breaks the links

MyAddress = "F136"
wbMaster.Worksheets("SC").Copy After:=wbReport.Worksheets(wbReport.Worksheets.Count) 'copies the pages
Cells.Copy 'COPY ALL THE CELLS IN A WORKBOOK
Cells.PasteSpecial xlPasteValues 'so it breaks the links
Next MyRow

For i = 1 To Application.SheetsInNewWorkbook ' deletes the first default sheets at the front of the workbook
wbReport.Worksheets("Sheet" & i).Delete
Next i

' ===== this section saves as Excel in the correct directory which is created by CreateDir subroutine ==========

strDir = strLoc & "Reports\"
Call CreateDir(strDir) ' this Function is located in ModF_Functions and is a standard function to create directories when they don't already exist
wbReport.SaveAs strDir & "Dealer Reports" & "_" & "Reports" & ".xls"

wbReport.PrintOut , , , , "Adobe PDF"

wbReport.Close True 'close active workbook

RowCount = RowCount + 1
Next MyCol

Application.ScreenUpdating = True 'this allows the page to be updated
Application.DisplayAlerts = True 'turn displays on
End Sub

xld
05-11-2012, 12:14 PM
I think the workbook would help.

monique
05-11-2012, 12:25 PM
Ok I managed to get this done however it is still holding the link to the original workbook, how do I code to break all links, (text boxes, charts, cells)