demetre
08-30-2007, 05:08 AM
Afternoon Everyone
My issue involves copying entire rows 3:62 of a certain sheet then pasting (values) into a certain worksheet in a Master workbook. I have searched other posts but cannot find a solution. It should be simple, but it has eluded me... :dunno
Here is my code, I know it is bloated, but i will improve efficiency once everything is running as expected. I will be copying the same number of rows for each sheet, but there are 7 different worksheets I am working with. The Master sheet has 7 worksheets (PL, FM, CC, SM, RC, MF, OD) and I would like to paste using End(xlUp), so bottom up process to last row...
'/ Option Explicit
Sub LoopthruWorkbook()
'/ Declare variables used in function
Dim path As String '/Setup pathway
Dim Mstr As Workbook '/ Master workbook
Dim wb As Workbook '/ Workbook to be manipulated
Dim ws As Worksheet '/ Worksheet to be manipulated
Dim ShtName As String
Dim lastRow As Long
Dim LastRowSrc As Long
Dim LastRowDst As Long
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
Dim CC As String
Dim SM As String
Dim RC As String
Dim MF As String
Dim OD As String
PL = ("PL")
FM = ("FM")
CC = ("CC")
SM = ("SM")
RC = ("RC")
MF = ("MF")
OD = ("OD")
Set Mstr = ActiveWorkbook '/ Set Master workbook as Active
path = "\\ccd\dfsroot$\users\xxxxx\xxxxx\My (file://\\ccd\dfsroot$\users\xxxxx\xxxxx\My) Documents\xxxx\"
MsgBox "Pathway has been found: " & path
StrFile = Dir(path & "*.xls", vbNormal) '/ tell StrFile which path to take
Do Until StrFile = "" '/ Loop through all workbooks in folder via path
If StrFile <> "Master.xls" Then '/ Exclude Master workbook
Workbooks.Open path & StrFile
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 worksheet during each iteration of the for loop due to some macros being recorded
Per = ws.Range("A2") '/ String in cell A2 dictates which macro called
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" '/ used for testing
Call Buff1 '/ Setup PL worksheet
Call Slim '/ Delete Row 63+
Call PivotBuff '/ Setup pivot data in column A
'/ **************************************************
'/ this is where I want to call copy, and then paste to Master in "PL" '/ worksheet
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
ws.Range("3:62" & lastRow).Copy
Mstr.Activate
Mstr.Sheets("PL").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
'/ ***************************************************
Else
If Per = "FM" Then '/ If cell A2 = worksheet name (FM worksheet type)
Call LD3FM(sh:=ws) '/ FM sub call
MsgBox "Called FM structure sub" '/ used for testing
Call Buff3 '/ Setup FM worksheet
Call Slim '/ Delete Row 63+
Call PivotBuff '/ Setup pivot data in column A
ws.Range("3:62").Copy Mstr.Sheets("FM").Range("A65536").End(xlUp)
Else
If Per = "CC" Then '/ If cell A2 = worksheet name (FM worksheet type)
Call LD3CC(sh:=ws) '/ FM sub call
MsgBox "Called CC structure sub" '/ used for testing
Call Buff3 '/ Setup FM worksheet
Call Slim '/ Delete Row 63+
Call PivotBuff '/ Setup pivot data in column A
Range("3:62").Copy Mstr.Sheets("CC").Range("A65536").End(xlUp)
Else
If Per = "SM" Then '/ If cell A2 = worksheet name (FM worksheet type)
Call LD3SM(sh:=ws) '/ FM sub call
MsgBox "Called SM structure sub" '/ used for testing
Call Buff2 '/ Setup SM worksheet
Call Slim '/ Delete Row 63+
Call PivotBuff '/ Setup pivot data in column A
Range("3:62").Copy Mstr.Sheets("SM").Range("A65536").End(xlUp)
Else
If Per = "RC" Then '/ If cell A2 = worksheet name (FM worksheet type)
Call LD3RC(sh:=ws) '/ FM sub call
MsgBox "Called RC structure sub" '/ used for testing
Call Buff3 '/ Setup RC worksheet
Call Slim '/ Delete Row 63+
Call PivotBuff '/ Setup pivot data in column A
Range("3:62").Copy Mstr.Sheets("RC").Range("A65536").End(xlUp)
Else
If Per = "MF" Then '/ If cell A2 = worksheet name (FM worksheet type)
Call LD3MF(sh:=ws) '/ FM sub call
MsgBox "Called MF structure sub" '/ used for testing
Call Buff2 '/ Setup MF worksheet
Call Slim '/ Delete Row 63+
Call PivotBuff '/ Setup pivot data in column A
Range("3:62").Copy Mstr.Sheets("MF").Range("A65536").End(xlUp)
Else
If Per = "OD" Then '/ If cell A2 = worksheet name (FM worksheet type)
Call LD3OD(sh:=ws) '/ FM sub call
MsgBox "Called OD structure sub" '/ used for testing
Call Buff3 '/ Setup OD worksheet
Call Slim '/ Delete Row 63+
Call PivotBuff '/ Setup pivot data in column A
Range("3:62").Copy Mstr.Sheets("OD").Range("A65536").End(xlUp)
Else
MsgBox "Error not correct format"
On Error GoTo 0
End If '/ End If statement
End If '/ End If statement
End If '/ End If statement
End If '/ End If statement
End If '/ End If statement
End If '/ End If statement
End If '/ End If statement
Next ws '/ End For loop
wb.Close False
End If '/ End If statement for StrFile != to Master
StrFile = Dir() '/ Find next workbook
Loop '/ End Do 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 WrkSht As Worksheet '/ Workbook
Dim MyStr As String
Dim String1 As String
Dim String2 As String
Dim Pivot As String
On Error Resume Next
For Each WrkSht In ActiveWorkbook.Worksheets
'/ Begin the loop
WrkSht.Range("A1") = WrkSht.Name
WrkSht.Range("HI1") = Range("A1")
'/ Breakup Sheetname
String1 = WrkSht.Range("A1") '/ Sheetname
String2 = WrkSht.Range("C5") '/ Cell name
WrkSht.Range("A3") = Mid(String2, 10, 2)
WrkSht.Range("A4") = Mid(String1, 10, 2)
'/ Compare Cell C5 against work sheetname to see what suits pivot point / naming convention
If String1 = String2 Then '/ If worksheet name and cell C5 match then use worksheet name as pivot point
WrkSht.Range("A2") = Mid(String1, 10, 2)
Else
If WrkSht.Range("A3") = "PL" Then
WrkSht.Range("A2") = WrkSht.Range("A3")
Else
If WrkSht.Range("A3") = "FM" Then
WrkSht.Range("A2") = WrkSht.Range("A3")
Else
If WrkSht.Range("A3") = "CC" Then
WrkSht.Range("A2") = WrkSht.Range("A3")
Else
If WrkSht.Range("A3") = "FM" Then
WrkSht.Range("A2") = WrkSht.Range("A3")
Else
If WrkSht.Range("A3") = "SM" Then
WrkSht.Range("A2") = WrkSht.Range("A3")
Else
If WrkSht.Range("A3") = "RC" Then
WrkSht.Range("A2") = WrkSht.Range("A3")
Else
If WrkSht.Range("A3") = "MF" Then
WrkSht.Range("A2") = WrkSht.Range("A3")
Else
If WrkSht.Range("A3") = "OD" Then
WrkSht.Range("A2") = WrkSht.Range("A3")
Else
If WrkSht.Range("A4") = "PL" Then
WrkSht.Range("A2") = WrkSht.Range("A4")
Else
If WrkSht.Range("A4") = "FM" Then
WrkSht.Range("A2") = WrkSht.Range("A4")
Else
If MWrkSht.Range("A4") = "CC" Then
WrkSht.Range("A2") = WrkSht.Range("A4")
Else
If WrkSht.Range("A4") = "FM" Then
WrkSht.Range("A2") = WrkSht.Range("A4")
Else
If WrkSht.Range("A4") = "SM" Then
WrkSht.Range("A2") = WrkSht.Range("A4")
Else
If WrkSht.Range("A4") = "RC" Then
WrkSht.Range("A2") = WrkSht.Range("A4")
Else
If WrkSht.Range("A4") = "MF" Then
WrkSht.Range("A2") = WrkSht.Range("A4")
Else
If WrkSht.Range("A4") = "OD" Then
WrkSht.Range("A2") = WrkSht.Range("A4")
Else
MsgBox "Incorrect naming convention used with worksheet: " & WrkSht.Name
On Error GoTo 0
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next WrkSht '/ End For loop
End Sub
Private Sub Buff1() '/ PL worksheet setup only
Range("B3:B62").Cut Destination:=Range("C3:C62")
Range("D3").Copy Destination:=Range("D4:D62")
Range("E3").Copy Destination:=Range("E4:E62")
Range("F3").Copy Destination:=Range("F4:F62")
Range("G3").Copy Destination:=Range("G4:G62")
Range("H3").Copy Destination:=Range("H4:H62")
End Sub
Private Sub Buff2() '/ Setup worksheet for SM / MF
Range("D3").Copy Destination:=Range("D4:D62")
Range("E3").Copy Destination:=Range("E4:E62")
Range("F3").Copy Destination:=Range("F4:F62")
Range("G3").Copy Destination:=Range("G4:G62")
Range("H3").Copy Destination:=Range("H4:H62")
End Sub
Private Sub Buff3() '/ Setup worksheets FM / CC / RC / OD
Range("D3").Copy Destination:=Range("D4:D62")
Range("E3").Copy Destination:=Range("E4:E62")
Range("F3").Copy Destination:=Range("F4:F62")
Range("G3").Copy Destination:=Range("G4:G62")
End Sub
Private Sub Slim()
'/ Delete extra work sheet data
Range("63:65536").EntireRow.Delete
End Sub
Private Sub PivotBuff() '/ Buff Pivot
Dim WS_Count As Integer '/ Total number of worksheets
Dim I As Integer '/ Start point
Dim WrkSht As Worksheet '/ Workbook
Dim MyStr As String
Dim String1 As String
Dim String2 As String
Dim Pivot As String
On Error Resume Next
For Each WrkSht In ActiveWorkbook.Worksheets
'/ Begin the loop
WrkSht.Range("B3") = WrkSht.Name
WrkSht.Range("B4") = Range("D3")
'/ Breakup Sheetname
String1 = WrkSht.Range("B3") '/ Sheetname
String2 = WrkSht.Range("D3") '/ Cell name
WrkSht.Range("B5") = Mid(String2, 10, 2)
WrkSht.Range("B6") = Mid(String1, 10, 2)
If Mid(String1, 10, 2) = Mid(String2, 10, 2) Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B5") = "PL" Then
WrkSht.Range("D3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B5") = "FM" Then
WrkSht.Range("D3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B5") = "CC" Then
WrkSht.Range("D3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B5") = "FM" Then
WrkSht.Range("D3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B5") = "SM" Then
WrkSht.Range("D3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B5") = "RC" Then
WrkSht.Range("D3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B5") = "MF" Then
WrkSht.Range("D3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B5") = "OD" Then
WrkSht.Range("D3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B6") = "PL" Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B6") = "FM" Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If MWrkSht.Range("B6") = "CC" Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B6") = "FM" Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B6") = "SM" Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B6") = "RC" Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B6") = "MF" Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B6") = "OD" Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
MsgBox "Error with Pivot Buff: " & WrkSht.Name
On Error GoTo 0
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next WrkSht '/ End For loop
End Sub
Thanks again for your time
My issue involves copying entire rows 3:62 of a certain sheet then pasting (values) into a certain worksheet in a Master workbook. I have searched other posts but cannot find a solution. It should be simple, but it has eluded me... :dunno
Here is my code, I know it is bloated, but i will improve efficiency once everything is running as expected. I will be copying the same number of rows for each sheet, but there are 7 different worksheets I am working with. The Master sheet has 7 worksheets (PL, FM, CC, SM, RC, MF, OD) and I would like to paste using End(xlUp), so bottom up process to last row...
'/ Option Explicit
Sub LoopthruWorkbook()
'/ Declare variables used in function
Dim path As String '/Setup pathway
Dim Mstr As Workbook '/ Master workbook
Dim wb As Workbook '/ Workbook to be manipulated
Dim ws As Worksheet '/ Worksheet to be manipulated
Dim ShtName As String
Dim lastRow As Long
Dim LastRowSrc As Long
Dim LastRowDst As Long
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
Dim CC As String
Dim SM As String
Dim RC As String
Dim MF As String
Dim OD As String
PL = ("PL")
FM = ("FM")
CC = ("CC")
SM = ("SM")
RC = ("RC")
MF = ("MF")
OD = ("OD")
Set Mstr = ActiveWorkbook '/ Set Master workbook as Active
path = "\\ccd\dfsroot$\users\xxxxx\xxxxx\My (file://\\ccd\dfsroot$\users\xxxxx\xxxxx\My) Documents\xxxx\"
MsgBox "Pathway has been found: " & path
StrFile = Dir(path & "*.xls", vbNormal) '/ tell StrFile which path to take
Do Until StrFile = "" '/ Loop through all workbooks in folder via path
If StrFile <> "Master.xls" Then '/ Exclude Master workbook
Workbooks.Open path & StrFile
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 worksheet during each iteration of the for loop due to some macros being recorded
Per = ws.Range("A2") '/ String in cell A2 dictates which macro called
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" '/ used for testing
Call Buff1 '/ Setup PL worksheet
Call Slim '/ Delete Row 63+
Call PivotBuff '/ Setup pivot data in column A
'/ **************************************************
'/ this is where I want to call copy, and then paste to Master in "PL" '/ worksheet
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
ws.Range("3:62" & lastRow).Copy
Mstr.Activate
Mstr.Sheets("PL").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
'/ ***************************************************
Else
If Per = "FM" Then '/ If cell A2 = worksheet name (FM worksheet type)
Call LD3FM(sh:=ws) '/ FM sub call
MsgBox "Called FM structure sub" '/ used for testing
Call Buff3 '/ Setup FM worksheet
Call Slim '/ Delete Row 63+
Call PivotBuff '/ Setup pivot data in column A
ws.Range("3:62").Copy Mstr.Sheets("FM").Range("A65536").End(xlUp)
Else
If Per = "CC" Then '/ If cell A2 = worksheet name (FM worksheet type)
Call LD3CC(sh:=ws) '/ FM sub call
MsgBox "Called CC structure sub" '/ used for testing
Call Buff3 '/ Setup FM worksheet
Call Slim '/ Delete Row 63+
Call PivotBuff '/ Setup pivot data in column A
Range("3:62").Copy Mstr.Sheets("CC").Range("A65536").End(xlUp)
Else
If Per = "SM" Then '/ If cell A2 = worksheet name (FM worksheet type)
Call LD3SM(sh:=ws) '/ FM sub call
MsgBox "Called SM structure sub" '/ used for testing
Call Buff2 '/ Setup SM worksheet
Call Slim '/ Delete Row 63+
Call PivotBuff '/ Setup pivot data in column A
Range("3:62").Copy Mstr.Sheets("SM").Range("A65536").End(xlUp)
Else
If Per = "RC" Then '/ If cell A2 = worksheet name (FM worksheet type)
Call LD3RC(sh:=ws) '/ FM sub call
MsgBox "Called RC structure sub" '/ used for testing
Call Buff3 '/ Setup RC worksheet
Call Slim '/ Delete Row 63+
Call PivotBuff '/ Setup pivot data in column A
Range("3:62").Copy Mstr.Sheets("RC").Range("A65536").End(xlUp)
Else
If Per = "MF" Then '/ If cell A2 = worksheet name (FM worksheet type)
Call LD3MF(sh:=ws) '/ FM sub call
MsgBox "Called MF structure sub" '/ used for testing
Call Buff2 '/ Setup MF worksheet
Call Slim '/ Delete Row 63+
Call PivotBuff '/ Setup pivot data in column A
Range("3:62").Copy Mstr.Sheets("MF").Range("A65536").End(xlUp)
Else
If Per = "OD" Then '/ If cell A2 = worksheet name (FM worksheet type)
Call LD3OD(sh:=ws) '/ FM sub call
MsgBox "Called OD structure sub" '/ used for testing
Call Buff3 '/ Setup OD worksheet
Call Slim '/ Delete Row 63+
Call PivotBuff '/ Setup pivot data in column A
Range("3:62").Copy Mstr.Sheets("OD").Range("A65536").End(xlUp)
Else
MsgBox "Error not correct format"
On Error GoTo 0
End If '/ End If statement
End If '/ End If statement
End If '/ End If statement
End If '/ End If statement
End If '/ End If statement
End If '/ End If statement
End If '/ End If statement
Next ws '/ End For loop
wb.Close False
End If '/ End If statement for StrFile != to Master
StrFile = Dir() '/ Find next workbook
Loop '/ End Do 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 WrkSht As Worksheet '/ Workbook
Dim MyStr As String
Dim String1 As String
Dim String2 As String
Dim Pivot As String
On Error Resume Next
For Each WrkSht In ActiveWorkbook.Worksheets
'/ Begin the loop
WrkSht.Range("A1") = WrkSht.Name
WrkSht.Range("HI1") = Range("A1")
'/ Breakup Sheetname
String1 = WrkSht.Range("A1") '/ Sheetname
String2 = WrkSht.Range("C5") '/ Cell name
WrkSht.Range("A3") = Mid(String2, 10, 2)
WrkSht.Range("A4") = Mid(String1, 10, 2)
'/ Compare Cell C5 against work sheetname to see what suits pivot point / naming convention
If String1 = String2 Then '/ If worksheet name and cell C5 match then use worksheet name as pivot point
WrkSht.Range("A2") = Mid(String1, 10, 2)
Else
If WrkSht.Range("A3") = "PL" Then
WrkSht.Range("A2") = WrkSht.Range("A3")
Else
If WrkSht.Range("A3") = "FM" Then
WrkSht.Range("A2") = WrkSht.Range("A3")
Else
If WrkSht.Range("A3") = "CC" Then
WrkSht.Range("A2") = WrkSht.Range("A3")
Else
If WrkSht.Range("A3") = "FM" Then
WrkSht.Range("A2") = WrkSht.Range("A3")
Else
If WrkSht.Range("A3") = "SM" Then
WrkSht.Range("A2") = WrkSht.Range("A3")
Else
If WrkSht.Range("A3") = "RC" Then
WrkSht.Range("A2") = WrkSht.Range("A3")
Else
If WrkSht.Range("A3") = "MF" Then
WrkSht.Range("A2") = WrkSht.Range("A3")
Else
If WrkSht.Range("A3") = "OD" Then
WrkSht.Range("A2") = WrkSht.Range("A3")
Else
If WrkSht.Range("A4") = "PL" Then
WrkSht.Range("A2") = WrkSht.Range("A4")
Else
If WrkSht.Range("A4") = "FM" Then
WrkSht.Range("A2") = WrkSht.Range("A4")
Else
If MWrkSht.Range("A4") = "CC" Then
WrkSht.Range("A2") = WrkSht.Range("A4")
Else
If WrkSht.Range("A4") = "FM" Then
WrkSht.Range("A2") = WrkSht.Range("A4")
Else
If WrkSht.Range("A4") = "SM" Then
WrkSht.Range("A2") = WrkSht.Range("A4")
Else
If WrkSht.Range("A4") = "RC" Then
WrkSht.Range("A2") = WrkSht.Range("A4")
Else
If WrkSht.Range("A4") = "MF" Then
WrkSht.Range("A2") = WrkSht.Range("A4")
Else
If WrkSht.Range("A4") = "OD" Then
WrkSht.Range("A2") = WrkSht.Range("A4")
Else
MsgBox "Incorrect naming convention used with worksheet: " & WrkSht.Name
On Error GoTo 0
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next WrkSht '/ End For loop
End Sub
Private Sub Buff1() '/ PL worksheet setup only
Range("B3:B62").Cut Destination:=Range("C3:C62")
Range("D3").Copy Destination:=Range("D4:D62")
Range("E3").Copy Destination:=Range("E4:E62")
Range("F3").Copy Destination:=Range("F4:F62")
Range("G3").Copy Destination:=Range("G4:G62")
Range("H3").Copy Destination:=Range("H4:H62")
End Sub
Private Sub Buff2() '/ Setup worksheet for SM / MF
Range("D3").Copy Destination:=Range("D4:D62")
Range("E3").Copy Destination:=Range("E4:E62")
Range("F3").Copy Destination:=Range("F4:F62")
Range("G3").Copy Destination:=Range("G4:G62")
Range("H3").Copy Destination:=Range("H4:H62")
End Sub
Private Sub Buff3() '/ Setup worksheets FM / CC / RC / OD
Range("D3").Copy Destination:=Range("D4:D62")
Range("E3").Copy Destination:=Range("E4:E62")
Range("F3").Copy Destination:=Range("F4:F62")
Range("G3").Copy Destination:=Range("G4:G62")
End Sub
Private Sub Slim()
'/ Delete extra work sheet data
Range("63:65536").EntireRow.Delete
End Sub
Private Sub PivotBuff() '/ Buff Pivot
Dim WS_Count As Integer '/ Total number of worksheets
Dim I As Integer '/ Start point
Dim WrkSht As Worksheet '/ Workbook
Dim MyStr As String
Dim String1 As String
Dim String2 As String
Dim Pivot As String
On Error Resume Next
For Each WrkSht In ActiveWorkbook.Worksheets
'/ Begin the loop
WrkSht.Range("B3") = WrkSht.Name
WrkSht.Range("B4") = Range("D3")
'/ Breakup Sheetname
String1 = WrkSht.Range("B3") '/ Sheetname
String2 = WrkSht.Range("D3") '/ Cell name
WrkSht.Range("B5") = Mid(String2, 10, 2)
WrkSht.Range("B6") = Mid(String1, 10, 2)
If Mid(String1, 10, 2) = Mid(String2, 10, 2) Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B5") = "PL" Then
WrkSht.Range("D3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B5") = "FM" Then
WrkSht.Range("D3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B5") = "CC" Then
WrkSht.Range("D3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B5") = "FM" Then
WrkSht.Range("D3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B5") = "SM" Then
WrkSht.Range("D3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B5") = "RC" Then
WrkSht.Range("D3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B5") = "MF" Then
WrkSht.Range("D3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B5") = "OD" Then
WrkSht.Range("D3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B6") = "PL" Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B6") = "FM" Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If MWrkSht.Range("B6") = "CC" Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B6") = "FM" Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B6") = "SM" Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B6") = "RC" Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B6") = "MF" Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
If WrkSht.Range("B6") = "OD" Then
WrkSht.Range("B3").Copy Destination:=WrkSht.Range("A3:A62")
Else
MsgBox "Error with Pivot Buff: " & WrkSht.Name
On Error GoTo 0
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next WrkSht '/ End For loop
End Sub
Thanks again for your time