PDA

View Full Version : Solved: Extract data from different worksheets & multiple workbooks using certain folder



demetre
08-23-2007, 06:28 AM
Good afternoon everyone

Currently I have issues with some of my conditional statements when I run my VBA code... :motz2:

What does work:
unprotect each worksheet in workbook
Name "A1" string after sheetname called in each worksheet
Extract 2 characters from "A1" and input string value in "A2" in each worksheet

What does not work:
Conditional If statements do not work. What I can see (i think) the code auto calls all functions without any conditions being met. So 1st worksheet calls the function PL, then states "A2" is equal to "FM", but calls the FM to the same sheet, not the next worksheet. Then I get the error because in the 3rd worksheet the string name is less than 10 characters (for testing), and I receive my error message.

So in a nutshell, what I want is once the condition is met, then move to the next worksheet, and call the allocated function.

High level pseudo code plan as follows:

Set pathway to folder which will store all workbooks of interest (not used currently, but will)
For each workbook in certain folder (not used currently, but will)

Unprotect all worksheets
Name cell ?A1? with sheetname function

For each worksheet in workbook
Use Mid in ?A2? to extract 2 characters from ?A1? cell

If ?A2? = PL
Call PL function
ElseIf ?A2? = FM
Call FM function
Else
GoTo Error 0

End If

Copy data into specific worksheet in Master workbook(currently not using this, but will be done in final version)

Next worksheet

End For loop for the workbook

End For loop for every workbook


Note:

Function calls (Private Subs) PL and FM are recorded macros which have no issues, and extract the data with no problems. In reality I have 8 different macros I want to call, but using 2 now will suffice till I can get this handling issue sorted
Depending on the extracted string in "A2" calls its associated function call eg either PL or FMMain Function Call

'/Option Explicit
Sub LoopthruWorkbook()
Dim wb As Workbook
Dim ws As Worksheet
Dim ShtName As String
Dim MyStr As String
Dim Per As String
Dim PL As String
Dim FM As String
PL = ("PL")
FM = ("FM")

On Error Resume Next

Call UnProtectAll '/ Unprotect all worksheets in workbook
MsgBox "each worksheet is now unprotected"

'/ Name cell A1 & A2 with sheetname
Call SheetNameCell

' Set WS_Count equal to the number of worksheets in the active workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
MsgBox "number of worksheets in workbook:" & WS_Count

For Each ws In ActiveWorkbook.Worksheets
'/Set ws = ActiveSheet

Per = ws.Range("A2")
MsgBox "A2 value is: " & Per

If Per = "PL" Then '/ If cell A2 = worksheet name (PL worksheet type)

Call LD3PL '/PL sub call
MsgBox "called PL structure sub"

'/setup PL worksheet, buffer with extra data in empty cells
'/Buff up pivot point to full 60 rows to match number of months
'ws.Range("A3:A62").Select.Copy.PasteSpecial

'/Delete extra work sheet data
'Range("63:65536").EntireRow.Delete
'ws.Range("63:65536").EntireRow.Delete
'MsgBox "Just deleted Rows 63 to 65536 of PL worksheet"

Else
If Per = "FM" Then '/ If cell A2 = worksheet name (FM worksheet type)

Call LD3FM '/FM sub call
MsgBox "Called FM sub"

'/Delete extra work sheet data
'Range("63:65536").EntireRow.Delete
'ws.Range("63:65536").EntireRow.Delete
'MsgBox "Just deleted Rows 63 to 65536 of FM worksheet"
Else

MsgBox "Error not correct format"
On Error GoTo 0

'End If
End If

Next ws '/End For loop
End Sub
Private Sub LD3PL()
'/
'/ LD3PL Macro
'/ Macro recorded 06/08/2007 by demetre
'/
'/
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Rows("1:10").Select
Selection.Clear
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "pivot"
Range("B2").Select
ActiveCell.FormulaR1C1 = "question"
Range("C1").Select
ActiveCell.FormulaR1C1 = "time period"
Columns("D:D").Select
Columns("C:C").ColumnWidth = 11.14
ActiveWindow.SmallScroll Down:=39
Range("F54").Select
ActiveWindow.SmallScroll Down:=36
Range("G111:BN111").Select
Selection.Copy
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=-132
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
ActiveWindow.SmallScroll Down:=39
Range("C63").Select
ActiveWindow.SmallScroll Down:=-9
Rows("79:89").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Rows("80:94").Select
Selection.Delete Shift:=xlUp
Rows("81:85").Select
Selection.Delete Shift:=xlUp
Rows("90:91").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=12
Rows("97:100").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=15
Rows("106:107").Select
Selection.Delete Shift:=xlUp
Rows("113:116").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=15
Rows("122:126").Select
Selection.Delete Shift:=xlUp
Rows("132:133").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=18
Rows("139:139").Select
ActiveWindow.SmallScroll Down:=18
Rows("139:161").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=-12
Rows("148:149").Select
Selection.Delete Shift:=xlUp
Rows("155:156").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=15
Rows("164:165").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=18
Rows("171:172").Select
Selection.Delete Shift:=xlUp
Rows("180:180").Select
ActiveWindow.SmallScroll Down:=15
Rows("180:186").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=-105
Rows("78:78").Select
Selection.Delete Shift:=xlUp
Range("E89").Select
ActiveCell.FormulaR1C1 = "11 extra"
Range("E90").Select
ActiveCell.FormulaR1C1 = "11 extra"
Range("E89:E90").Select
Selection.AutoFill Destination:=Range("E89:E95"), Type:=xlFillDefault
Range("E89:E95").Select
ActiveWindow.SmallScroll Down:=15
Range("E105").Select
ActiveCell.FormulaR1C1 = "21 extra"
Range("E106").Select
ActiveCell.FormulaR1C1 = "21 extra"
Range("E105:E106").Select
Selection.AutoFill Destination:=Range("E105:E111"), Type:=xlFillDefault
Range("E105:E111").Select
ActiveWindow.SmallScroll Down:=21
Range("E131").Select
ActiveCell.FormulaR1C1 = "41 extra"
Range("E132").Select
ActiveCell.FormulaR1C1 = "41 extra"
Range("E131:E132").Select
Selection.AutoFill Destination:=Range("E131:E137"), Type:=xlFillDefault
Range("E131:E137").Select
ActiveWindow.SmallScroll Down:=18
Range("E147").Select
ActiveCell.FormulaR1C1 = "51 extra"
Range("E148").Select
ActiveCell.FormulaR1C1 = "51 extra"
Range("E147:E148").Select
Selection.AutoFill Destination:=Range("E147:E153"), Type:=xlFillDefault
Range("E147:E153").Select
ActiveWindow.SmallScroll Down:=18
Range("E163").Select
ActiveCell.FormulaR1C1 = "60 extra"
Range("E164").Select
ActiveCell.FormulaR1C1 = "60 extra"
Range("E163:E164").Select
Selection.AutoFill Destination:=Range("E163:E169"), Type:=xlFillDefault
Range("E163:E169").Select
Range("E75:E184").Select
Range("E184").Activate
Selection.Copy
ActiveWindow.SmallScroll Down:=-90
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveWindow.SmallScroll Down:=51
Range("F75:F184").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=-174
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveWindow.SmallScroll Down:=48
Range("G75:G79").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=-78
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Range("I3").Select
ActiveWindow.SmallScroll Down:=51
Range("G80:BN184").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollColumn = 61
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 58
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 42
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=-177
ActiveWindow.SmallScroll ToRight:=2
Range("I3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveWindow.ScrollColumn = 1
Rows("1:1").Select
ActiveWindow.SmallScroll Down:=21
Rows("1:62").Select
Selection.EntireRow.Hidden = False
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveWindow.SmallScroll Down:=-54
Range("B1").Select
End Sub

Private Sub LD3FM()
'
' LD3FM Macro
' Macro recorded 02/08/2007 by demetre
'
'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Rows("1:3").Select
Selection.Clear
Range("H4:H7").Select
Selection.ClearContents
Range("A1").Select
ActiveCell.FormulaR1C1 = "pivot"
Range("B2").Select
ActiveCell.FormulaR1C1 = "Q"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Q"
Range("B1").Select
ActiveCell.FormulaR1C1 = ""
Range("C1").Select
ActiveCell.FormulaR1C1 = "Time Period"
Columns("C:C").Select
Selection.ColumnWidth = 12.14
ActiveWindow.SmallScroll Down:=9
Range("G29:BN29").Select
Selection.Copy
ActiveWindow.ScrollColumn = 61
ActiveWindow.ScrollColumn = 60
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 57
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=-45
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Rows("1:10").Select
Selection.Clear
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Rows("1:5").Select
Selection.Insert Shift:=xlDown
ActiveWindow.SmallScroll Down:=42
Range("C66:C127").Select
Selection.Cut
ActiveWindow.SmallScroll Down:=-84
Range("C1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=24
Range("A66:B67").Select
Selection.Cut
ActiveWindow.SmallScroll Down:=-81
Range("A1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=42
Rows("73:87").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=6
Rows("74:79").Select
Selection.Delete Shift:=xlUp
Rows("83:84").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=18
Rows("90:93").Select
Selection.Delete Shift:=xlUp
Rows("99:100").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=12
Rows("106:109").Select
Selection.Delete Shift:=xlUp
Rows("115:117").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=15
Rows("125:126").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=15
Rows("132:132").Select
ActiveWindow.SmallScroll Down:=15
Rows("132:155").Select
Selection.Delete Shift:=xlUp
Rows("141:142").Select
Selection.Delete Shift:=xlUp
Rows("148:149").Select
Selection.Delete Shift:=xlUp
Rows("157:158").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=15
Rows("164:165").Select
Selection.Delete Shift:=xlUp
Rows("173:173").Select
ActiveWindow.SmallScroll Down:=9
Rows("173:178").Select
Selection.Delete Shift:=xlUp
Range("B179").Select
ActiveWindow.SmallScroll Down:=-84
Range("E83").Select
ActiveCell.FormulaR1C1 = "11 extra"
Range("E84").Select
ActiveCell.FormulaR1C1 = "11 extra"
Range("E83:E84").Select
Selection.AutoFill Destination:=Range("E83:E89"), Type:=xlFillDefault
Range("E83:E89").Select
ActiveWindow.SmallScroll Down:=12
Range("E99").Select
ActiveCell.FormulaR1C1 = "20 extra"
Range("E100").Select
ActiveCell.FormulaR1C1 = "20 extra"
Range("E99:E100").Select
Selection.AutoFill Destination:=Range("E99:E105"), Type:=xlFillDefault
Range("E99:E105").Select
ActiveWindow.SmallScroll Down:=18
Range("E125").Select
ActiveCell.FormulaR1C1 = "40 extra"
Range("E126").Select
ActiveCell.FormulaR1C1 = "40 extra"
Range("E125:E126").Select
Selection.AutoFill Destination:=Range("E125:E131"), Type:=xlFillDefault
Range("E125:E131").Select
ActiveWindow.SmallScroll Down:=21
Range("E141").Select
ActiveCell.FormulaR1C1 = "49 extra"
Range("E142").Select
ActiveCell.FormulaR1C1 = "49 extra"
Range("E141:E142").Select
Selection.AutoFill Destination:=Range("E141:E147"), Type:=xlFillDefault
Range("E141:E147").Select
ActiveWindow.SmallScroll Down:=15
Range("E157").Select
ActiveCell.FormulaR1C1 = "58 extra"
Range("E158").Select
ActiveCell.FormulaR1C1 = "58 extra"
Range("E157:E158").Select
Selection.AutoFill Destination:=Range("E157:E163"), Type:=xlFillDefault
Range("E157:E163").Select
Range("E70:E173").Select
Range("E173").Activate
Selection.Copy
ActiveWindow.SmallScroll Down:=-111
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
ActiveWindow.SmallScroll Down:=48
Range("F70:F173").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=-174
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveWindow.SmallScroll Down:=45
Range("G70:G73").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=-81
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Range("H3").Select
ActiveWindow.SmallScroll Down:=48
Range("G74:BN89").Select
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 57
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 51
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 47
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 43
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 35
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
Range("G74:BN173").Select
ActiveWindow.SmallScroll Down:=-96
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 51
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=-81
Range("H3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Columns("F:F").ColumnWidth = 23.29
ActiveWindow.SmallScroll Down:=45
Range("J71").Select
ActiveWindow.SmallScroll Down:=-102
Rows("1:2").Select
Range("A2").Activate
ActiveWindow.SmallScroll Down:=21
Rows("2:62").Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveWindow.SmallScroll Down:=-51
Range("E9").Select
ActiveWindow.SmallScroll Down:=-24
Range("B1").Select
ActiveWindow.SmallScroll Down:=-45
End Sub
Private Sub ProtectAll()

Dim wsheet As Worksheet
Dim Pwd As String

For Each wsheet In Worksheets
wsheet.Protect Password:="gluestick"
Next wsheet

End Sub

Private Sub UnProtectAll()

Dim wsheet As Worksheet
Dim Pwd As String

For Each wsheet In Worksheets
wsheet.Unprotect Password:="gluestick"
Next wsheet

End Sub

Private Sub SheetNameCell()
Dim WS_Count As Integer '/ Total number of worksheets
Dim I As Integer '/ Start point
Dim ws As Worksheet '/ Workbook
Dim MyStr As String

On Error Resume Next

For Each ws In ActiveWorkbook.Worksheets
' Begin the loop.

'/ Set worksheet name in A2
ws.Range("A1") = ws.Name
ws.Range("HI1") = Range("A1")

'/ Breakup Sheetname
MyStr = ws.Range("A1")
ws.Range("A2") = Mid(MyStr, 10, 2)
ws.Range("HI2") = Range("A2")

Next ws '/ End For loop
End Sub

XLGibbs
08-23-2007, 06:43 AM
Some samples of similar concepts:

http://www.vbaexpress.com/forum/showthread.php?t=10854

http://www.vbaexpress.com/forum/showthread.php?t=6931&highlight=Copy+from+multiple+workbooks

I will try and take a look at your code, but there is a lot of unnecessary bits and pieces stuck in there from the macro recorder (all the scroll windows and such). it would be easier and likely faster for quality help if you could attach a sample file with both the source data format as well as the desired output...

Those other threads are two of MANY that are here that you can search for ideas on copying and pasting from multiple sheets to one.

demetre
08-23-2007, 06:58 AM
XLGibbs thanks for the reply...

I realise the extra garbage friom the macro recorder apologies for that, but sometimes it is quicker to do...:mkay

I have searched many threads on this forum, using a few of the segements of code already written which I appreciate... but copying to a master list, etc is not the issue that I have

My issue is the fact that I want to call a certain function (PL or FM) from the contents (String) based in a cell... then once the condition is met, then go to the next worksheet in the workbook, and start all the conditional statements again... but currently my code does not do that

thanks again for your time and effort

XLGibbs
08-23-2007, 07:28 AM
Hey no worries! The lnks I provided were just samples of modifyabe copying and manipulation...there are hundreds of them

Can you upload a sample of what you mean to do?

If I understand correctly,you have two functions (PL and FM) that are located in a cell on each sheet. If the cell as PL, then you run one routine, if it is FM, you run a different one. This should be pretty easy to clean up...


So, it looks like for the PL code, you are inserting 4 columns and 16 rows. Copying a range of data to B3 and transposing it. YOu then delete xxxx number of rows and fill down some values that are below the resulting pasted data and remaining after all the rows are deleted.

Then you copy the whole range and transpose that again.

Can you show me a before and after for this sequence? I think the code should only end up being about 10 or 12 lines. I can also help clean up the other function which appears to do something similar..

Let me know..

demetre
08-23-2007, 07:30 AM
Normally I would not put so many Msgbox statements in code but it helps me in testing...

Currently when I run my code I get the following


each worksheet becomes unprotected
MsgBox stating the correct number of worksheets = 3
cells A1 and A2 of 1st worksheet correctly populated with the worksheet name, and are the other sheets (Sheet 3 has only 7 characters, so A2 will not populate)
Msgbox stating A2 = PL with the correct sheetname associated
Calls the PL function
Msgbox A2 = FM with the correct sheetname, but
Calls the PL sub on the same 1st sheet
Msgbox A2 =" " and the and empty sheetname (both these are correct)
Calls PL function again on the 1st worksheetThus it can be seen that

the next worksheet is not activated, and the correct sub call to manipulate it
loops in regard to sheetname, etc are correct but the issue resides in the conditional statementsHope this may help

thanks again

Here's my code minus the erroneus macro recorder garbage... which contain the Subs PL and FM


'/Option Explicit
Sub LoopthruWorkbook()
Dim wb As Workbook
Dim ws As Worksheet
Dim ShtName As String
Dim MyStr As String
Dim SelectCase As String
Dim WS_Count As Integer
Dim Per As String
Dim PL As String
Dim FM As String
PL = ("PL")
FM = ("FM")
On Error Resume Next
Call UnProtectAll '/ Unprotect all worksheets in workbook
MsgBox "each worksheet is now unprotected"
'/ Name cell A1 & A2 with sheetname
Call SheetNameCell
' Set WS_Count equal to the number of worksheets in the active workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
MsgBox "number of worksheets in workbook:" & WS_Count
'For Each ws In wb.Worksheets
For Each ws In ActiveWorkbook.Worksheets
'/Set ws = ActiveSheet

Per = ws.Range("A2")
MsgBox "A2 value is: " & Per & " of worksheet named: " & ws.Name

If Per = ws.Range("PL") Then '/ If cell A2 = worksheet name (PL worksheet type)

Call LD3PL '/PL sub call
MsgBox "called PL structure sub"

'/setup PL worksheet, buffer with extra data in empty cells
'/Buff up pivot point to full 60 rows to match number of months
'ws.Range("A3:A62").Select.Copy.PasteSpecial

'/Delete extra work sheet data
'Range("63:65536").EntireRow.Delete
'ws.Range("63:65536").EntireRow.Delete
'MsgBox "Just deleted Rows 63 to 65536 of PL worksheet"

Else

If Per = ws.Range("FM") Then '/ If cell A2 = worksheet name (FM worksheet type)

Call LD3FM '/FM sub call
MsgBox "Called FM sub"

'/Delete extra work sheet data
'Range("63:65536").EntireRow.Delete
'ws.Range("63:65536").EntireRow.Delete
'MsgBox "Just deleted Rows 63 to 65536 of FM worksheet"
Else

MsgBox "Error not correct format"
On Error GoTo 0

End If
End If

Next ws '/End For loop
End Sub
Private Sub ProtectAll()

Dim wsheet As Worksheet
Dim Pwd As String

For Each wsheet In Worksheets
wsheet.Protect Password:="gluestick"
Next wsheet

End Sub

Private Sub UnProtectAll()

Dim wsheet As Worksheet
Dim Pwd As String

For Each wsheet In Worksheets
wsheet.Unprotect Password:="gluestick"
Next wsheet

End Sub
Private Sub SheetNameCell()
Dim WS_Count As Integer '/ Total number of worksheets
Dim I As Integer '/ Start point
Dim ws As Worksheet '/ Workbook
Dim MyStr As String
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
' Begin the loop.

'/ Set worksheet name in A2
ws.Range("A1") = ws.Name
ws.Range("HI1") = Range("A1")

'/ Breakup Sheetname
MyStr = ws.Range("A1")
ws.Range("A2") = Mid(MyStr, 10, 2)
ws.Range("HI2") = Range("A2")

Next ws '/ End For loop
End Sub

Bob Phillips
08-23-2007, 07:33 AM
I think that yhou need to pass the worksheet object to the called functions, like this



For Each ws In ActiveWorkbook.Worksheets

Per = ws.Range("A2")

If Per = "PL" Then
Call LD3PL(sh:=ws)

Else
If Per = "FM" Then

Call LD3F(sh:=ws)
Else

MsgBox "Error not correct format"
On Error Goto 0

'End If
End If

Next ws '/End For loop
End Sub
Private Sub LD3PL(sh As Worksheet)

sh.Columns("A:A").Select

'etc.


You will need to qualify all worksheet properties within those functions in a similar manner.

demetre
08-23-2007, 07:40 AM
XLGibbs

thank you again for your assistance...

i will upload a sanitised verison of my spreadsheet in a few moments

thanks

demetre
08-23-2007, 07:55 AM
I will try it xld thanks for your help... sorry i did not see your post before

demetre
08-23-2007, 07:56 AM
Here is a sanitised version of my spreadsheet

thanks again

XLGibbs
08-23-2007, 08:00 AM
demetre...that is a little TOO sanitized. With no data to see, it is hard to know what is supposed to go where

All I can gather is that yo want the data from each sheet to end up in 1 row of data on the master sheet... or isit the other way around?

demetre
08-23-2007, 08:15 AM
xld i tried your suggestion but unfortunately it does not resolve my issue:dunno

the sub functions still call both PL and FM on the first worksheet, but do nothing to the other worksheets...

ho hum... back to the drawing board i guess


thanks again i really appreciate it

XLGibbs
08-23-2007, 08:19 AM
YOur loop might work, but you "may" try "ws.Activate" inside the For each ws loop to make sure that it looks at the correct sheet. (It sounds as if, and depending on other matters in the code---that only sheet(1) remains active, thus accepts all of the code.

xld's solution would appear to work well by passing the sheets as an object variable to the sub.

demetre
08-23-2007, 08:24 AM
demetre...that is a little TOO sanitized. With no data to see, it is hard to know what is supposed to go where

All I can gather is that yo want the data from each sheet to end up in 1 row of data on the master sheet... or isit the other way around?

Yes i do aplogise about that... i was planning on utilising VBA code transpose the data at a later stage due to manipualtion time taking a little while...

basically i am transposing the data from the PL / FM worksheets to the masterlist whilst doing all the manipulation on the PL / FM worksheets 1st... it will autocopy Rows 2-62 from the FM sheet to the end of the master sheet (Master will have a 1 row header)

Data used is a mix of volume / prices

thanks again

demetre
08-23-2007, 08:26 AM
thanks for that ill give it a try as soon as i can

much appreciated

demetre
08-24-2007, 12:52 AM
Thanks XLGibbs and xld... :friends:

the ws.Activate was the key. So the current functional code is as follows... so for the erroneus macro recorder code... i will post tidy VBA code when I tie up all loose ends...

thanks to everyone for their help :clap:


'/ Option Explicit
Sub LoopthruWorkbook()
Dim wb As Workbook
Dim ws As Worksheet
Dim ShtName As String
Dim MyStr As String
Dim SelectCase As String
Dim WS_Count As Integer
Dim Per As String
Dim PL As String
Dim FM As String
PL = ("PL")
FM = ("FM")
On Error Resume Next
Call UnProtectAll '/ Unprotect all worksheets in workbook
MsgBox "each worksheet is now unprotected"
'/ Name cell A1 & A2 with sheetname
Call SheetNameCell
' Set WS_Count equal to the number of worksheets in the active workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
MsgBox "number of worksheets in workbook:" & WS_Count
For Each ws In ActiveWorkbook.Worksheets '/ start for loop for each worksheet in workbook
ws.Activate '/ Activate first worksheet
Per = ws.Range("A2") '/
MsgBox "A2 value is: " & Per & " of worksheet named: " & ws.Name

If Per = "PL" Then '/ If cell A2 = worksheet name (PL worksheet type)

Call LD3PL(sh:=ws) '/ PL sub call
MsgBox "called PL structure sub"

'/ setup PL worksheet, buffer with extra data in empty cells
'/ Buff up pivot point to full 60 rows to match number of months
'ws.Range("A3:A62").Select.Copy.PasteSpecial

'/ Delete extra work sheet data
'Range("63:65536").EntireRow.Delete
'ws.Range("63:65536").EntireRow.Delete
'MsgBox "Just deleted Rows 63 to 65536 of PL worksheet"

Else

If Per = "FM" Then '/ If cell A2 = worksheet name (FM worksheet type)

Call LD3FM(sh:=ws) '/ FM sub call
MsgBox "Called FM sub"

'/ Delete extra work sheet data
'Range("63:65536").EntireRow.Delete
'ws.Range("63:65536").EntireRow.Delete
'MsgBox "Just deleted Rows 63 to 65536 of FM worksheet"
Else

MsgBox "Error not correct format"
On Error GoTo 0

End If '/ End If statement
End If '/ End If statement


Next ws '/ End For loop
End Sub
Private Sub LD3PL(sh As Worksheet)
'/
'/ LD3PL Macro
'/ Macro recorded 06/08/2007 by demetre
'/
'/
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Rows("1:10").Select
Selection.Clear
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "pivot"
Range("B2").Select
ActiveCell.FormulaR1C1 = "question"
Range("C1").Select
ActiveCell.FormulaR1C1 = "time period"
Columns("D:D").Select
Columns("C:C").ColumnWidth = 11.14
ActiveWindow.SmallScroll Down:=39
Range("F54").Select
ActiveWindow.SmallScroll Down:=36
Range("G111:BN111").Select
Selection.Copy
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=-132
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
ActiveWindow.SmallScroll Down:=39
Range("C63").Select
ActiveWindow.SmallScroll Down:=-9
Rows("79:89").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Rows("80:94").Select
Selection.Delete Shift:=xlUp
Rows("81:85").Select
Selection.Delete Shift:=xlUp
Rows("90:91").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=12
Rows("97:100").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=15
Rows("106:107").Select
Selection.Delete Shift:=xlUp
Rows("113:116").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=15
Rows("122:126").Select
Selection.Delete Shift:=xlUp
Rows("132:133").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=18
Rows("139:139").Select
ActiveWindow.SmallScroll Down:=18
Rows("139:161").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=-12
Rows("148:149").Select
Selection.Delete Shift:=xlUp
Rows("155:156").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=15
Rows("164:165").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=18
Rows("171:172").Select
Selection.Delete Shift:=xlUp
Rows("180:180").Select
ActiveWindow.SmallScroll Down:=15
Rows("180:186").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=-105
Rows("78:78").Select
Selection.Delete Shift:=xlUp
Range("E89").Select
ActiveCell.FormulaR1C1 = "11 extra"
Range("E90").Select
ActiveCell.FormulaR1C1 = "11 extra"
Range("E89:E90").Select
Selection.AutoFill Destination:=Range("E89:E95"), Type:=xlFillDefault
Range("E89:E95").Select
ActiveWindow.SmallScroll Down:=15
Range("E105").Select
ActiveCell.FormulaR1C1 = "21 extra"
Range("E106").Select
ActiveCell.FormulaR1C1 = "21 extra"
Range("E105:E106").Select
Selection.AutoFill Destination:=Range("E105:E111"), Type:=xlFillDefault
Range("E105:E111").Select
ActiveWindow.SmallScroll Down:=21
Range("E131").Select
ActiveCell.FormulaR1C1 = "41 extra"
Range("E132").Select
ActiveCell.FormulaR1C1 = "41 extra"
Range("E131:E132").Select
Selection.AutoFill Destination:=Range("E131:E137"), Type:=xlFillDefault
Range("E131:E137").Select
ActiveWindow.SmallScroll Down:=18
Range("E147").Select
ActiveCell.FormulaR1C1 = "51 extra"
Range("E148").Select
ActiveCell.FormulaR1C1 = "51 extra"
Range("E147:E148").Select
Selection.AutoFill Destination:=Range("E147:E153"), Type:=xlFillDefault
Range("E147:E153").Select
ActiveWindow.SmallScroll Down:=18
Range("E163").Select
ActiveCell.FormulaR1C1 = "60 extra"
Range("E164").Select
ActiveCell.FormulaR1C1 = "60 extra"
Range("E163:E164").Select
Selection.AutoFill Destination:=Range("E163:E169"), Type:=xlFillDefault
Range("E163:E169").Select
Range("E75:E184").Select
Range("E184").Activate
Selection.Copy
ActiveWindow.SmallScroll Down:=-90
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveWindow.SmallScroll Down:=51
Range("F75:F184").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=-174
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveWindow.SmallScroll Down:=48
Range("G75:G79").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=-78
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Range("I3").Select
ActiveWindow.SmallScroll Down:=51
Range("G80:BN184").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollColumn = 61
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 58
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 42
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=-177
ActiveWindow.SmallScroll ToRight:=2
Range("I3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveWindow.ScrollColumn = 1
Rows("1:1").Select
ActiveWindow.SmallScroll Down:=21
Rows("1:62").Select
Selection.EntireRow.Hidden = False
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveWindow.SmallScroll Down:=-54
Range("B1").Select
End Sub

Private Sub LD3FM(sh As Worksheet)
'
' LD3FM Macro
' Macro recorded 02/08/2007 by demetre
'
'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Rows("1:3").Select
Selection.Clear
Range("H4:H7").Select
Selection.ClearContents
Range("A1").Select
ActiveCell.FormulaR1C1 = "pivot"
Range("B2").Select
ActiveCell.FormulaR1C1 = "Q"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Q"
Range("B1").Select
ActiveCell.FormulaR1C1 = ""
Range("C1").Select
ActiveCell.FormulaR1C1 = "Time Period"
Columns("C:C").Select
Selection.ColumnWidth = 12.14
ActiveWindow.SmallScroll Down:=9
Range("G29:BN29").Select
Selection.Copy
ActiveWindow.ScrollColumn = 61
ActiveWindow.ScrollColumn = 60
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 57
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=-45
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Rows("1:10").Select
Selection.Clear
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Rows("1:5").Select
Selection.Insert Shift:=xlDown
ActiveWindow.SmallScroll Down:=42
Range("C66:C127").Select
Selection.Cut
ActiveWindow.SmallScroll Down:=-84
Range("C1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=24
Range("A66:B67").Select
Selection.Cut
ActiveWindow.SmallScroll Down:=-81
Range("A1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=42
Rows("73:87").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=6
Rows("74:79").Select
Selection.Delete Shift:=xlUp
Rows("83:84").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=18
Rows("90:93").Select
Selection.Delete Shift:=xlUp
Rows("99:100").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=12
Rows("106:109").Select
Selection.Delete Shift:=xlUp
Rows("115:117").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=15
Rows("125:126").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=15
Rows("132:132").Select
ActiveWindow.SmallScroll Down:=15
Rows("132:155").Select
Selection.Delete Shift:=xlUp
Rows("141:142").Select
Selection.Delete Shift:=xlUp
Rows("148:149").Select
Selection.Delete Shift:=xlUp
Rows("157:158").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=15
Rows("164:165").Select
Selection.Delete Shift:=xlUp
Rows("173:173").Select
ActiveWindow.SmallScroll Down:=9
Rows("173:178").Select
Selection.Delete Shift:=xlUp
Range("B179").Select
ActiveWindow.SmallScroll Down:=-84
Range("E83").Select
ActiveCell.FormulaR1C1 = "11 extra"
Range("E84").Select
ActiveCell.FormulaR1C1 = "11 extra"
Range("E83:E84").Select
Selection.AutoFill Destination:=Range("E83:E89"), Type:=xlFillDefault
Range("E83:E89").Select
ActiveWindow.SmallScroll Down:=12
Range("E99").Select
ActiveCell.FormulaR1C1 = "20 extra"
Range("E100").Select
ActiveCell.FormulaR1C1 = "20 extra"
Range("E99:E100").Select
Selection.AutoFill Destination:=Range("E99:E105"), Type:=xlFillDefault
Range("E99:E105").Select
ActiveWindow.SmallScroll Down:=18
Range("E125").Select
ActiveCell.FormulaR1C1 = "40 extra"
Range("E126").Select
ActiveCell.FormulaR1C1 = "40 extra"
Range("E125:E126").Select
Selection.AutoFill Destination:=Range("E125:E131"), Type:=xlFillDefault
Range("E125:E131").Select
ActiveWindow.SmallScroll Down:=21
Range("E141").Select
ActiveCell.FormulaR1C1 = "49 extra"
Range("E142").Select
ActiveCell.FormulaR1C1 = "49 extra"
Range("E141:E142").Select
Selection.AutoFill Destination:=Range("E141:E147"), Type:=xlFillDefault
Range("E141:E147").Select
ActiveWindow.SmallScroll Down:=15
Range("E157").Select
ActiveCell.FormulaR1C1 = "58 extra"
Range("E158").Select
ActiveCell.FormulaR1C1 = "58 extra"
Range("E157:E158").Select
Selection.AutoFill Destination:=Range("E157:E163"), Type:=xlFillDefault
Range("E157:E163").Select
Range("E70:E173").Select
Range("E173").Activate
Selection.Copy
ActiveWindow.SmallScroll Down:=-111
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
ActiveWindow.SmallScroll Down:=48
Range("F70:F173").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=-174
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveWindow.SmallScroll Down:=45
Range("G70:G73").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll Down:=-81
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Range("H3").Select
ActiveWindow.SmallScroll Down:=48
Range("G74:BN89").Select
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 57
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 51
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 47
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 43
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 35
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
Range("G74:BN173").Select
ActiveWindow.SmallScroll Down:=-96
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 51
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=-81
Range("H3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Columns("F:F").ColumnWidth = 23.29
ActiveWindow.SmallScroll Down:=45
Range("J71").Select
ActiveWindow.SmallScroll Down:=-102
Rows("1:2").Select
Range("A2").Activate
ActiveWindow.SmallScroll Down:=21
Rows("2:62").Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveWindow.SmallScroll Down:=-51
Range("E9").Select
ActiveWindow.SmallScroll Down:=-24
Range("B1").Select
ActiveWindow.SmallScroll Down:=-45
End Sub
Private Sub ProtectAll()

Dim wsheet As Worksheet
Dim Pwd As String

For Each wsheet In Worksheets
wsheet.Protect Password:="gluestick"
Next wsheet

End Sub

Private Sub UnProtectAll()

Dim wsheet As Worksheet
Dim Pwd As String

For Each wsheet In Worksheets
wsheet.Unprotect Password:="gluestick"
Next wsheet

End Sub
Private Sub SheetNameCell()
Dim WS_Count As Integer '/ Total number of worksheets
Dim I As Integer '/ Start point
Dim ws As Worksheet '/ Workbook
Dim MyStr As String
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
' Begin the loop.

'/ Set worksheet name in A2
ws.Range("A1") = ws.Name
ws.Range("HI1") = Range("A1")

'/ Breakup Sheetname
MyStr = ws.Range("A1")
ws.Range("A2") = Mid(MyStr, 10, 2)
ws.Range("HI2") = Range("A2")

Next ws '/ End For loop
End Sub

Bob Phillips
08-24-2007, 01:14 AM
ws.Activate is the wrong solution IMO.

You pass the worksheet to the routines as I suggested, and then don't use them! If you did, there would be no need to activate the worksheet.

demetre
08-24-2007, 01:23 AM
ws.Activate is the wrong solution IMO.

You pass the worksheet to the routines as I suggested, and then don't use them! If you did, there would be no need to activate the worksheet.

xld...

i thought i followed your suggestion of

'You will need to qualify all worksheet properties within those functions in a similar manner.'

Could you please explain this in a little more detail to me

thanks

Bob Phillips
08-24-2007, 01:59 AM
What I mean is that in those functions, there are numerous uses of worksheet properties, such as



Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown


columns and rows being the properties in question here.

Because they are unqualified, they default to the activesheet (which is why activating ws first made your routines work). However, the proper way to do it is to qualify with the worksheet object, such as



Worksheets("Sheet1").Columns("A:A").Select


As you want this routine to work for many worksheets, you cannot hardcode the worksheet like that, but you can pass the worksheet object from the caller to this routine as a parameter, which you are already doing after my initial comments with this code



Call LD3PL(sh:=ws) '/ PL sub call

...

Private Sub LD3PL(sh As Worksheet)


and you change the code in the routine to use that worksheet argument




With sh.Columns("A:A")
.Insert Shift:=xlToRight
.Insert Shift:=xlToRight
.Insert Shift:=xlToRight
.Insert Shift:=xlToRight
End With
With sh.Rows("1:1").Select
.Insert Shift:=xlDown
.Insert Shift:=xlDown
.Insert Shift:=xlDown
.Insert Shift:=xlDown
.Insert Shift:=xlDown
.Insert Shift:=xlDown
.Insert Shift:=xlDown
.Insert Shift:=xlDown
.Insert Shift:=xlDown
.Insert Shift:=xlDown
End With


which is better because you are explicitly controlling which object is being processed (avoiding problems like your original problem), and you are avoiding the dreaded selects with all of the incumbent overheads that that entails.

demetre
08-24-2007, 02:23 AM
xld thanks for the explanation...

i will try and implement your suggestions

thanks again