code to insert cell value in footer and copy one line from each new tab to a totals page

[pile-it Mark]

i have a workbook that i use to send trips to accounting. I have cobbled this together over many years and thought i would try to automate more of it. the data is transferred from written sheets, i just automated the math. new year new sheet, there has to be a better way.

i have asked questions on other posts concerning the relevant ideas.

the only micros i have ever used were given to me from this forum. VBA is a foreign language. i have managed with formulas to this point.

i have a master tab that i copy and add the trip information to. somewhere between 60 and 250 tabs will be added over the year. individual trips.

what i am trying to accomplish:

Cell C2 i would like to be in the Left footer of the individual tabs, this is different for each sheet

cell N4 i would like to post in the center footer. i have read the posts about the micro to do that and have tried to copy them with no success. this is different for each sheet.

i would like line 2 cells B:AE to be added to the totals pages. currently i just create links to the individual cells. this line just pulls the totals off the sheet to a common area.

i thought i could use VLookup to grab mileage off the distance tab, but i am struggling trying to search e12 and f 12 to put the distance in j22 from the Distance table B3:E318 the number is in column 4
e13 & f13 would go in k22 they wont all be filled usually.

i would appreciate any help or comments. including formula changes. i need to learn VBA

Thanks,
Mark

a copy of the workbook is located in dropbox link below.

https://www.dropbox.com/s/2w9lr6u80j0i9p6/Mr Excell test.xlsm?dl=0

 

[pile-it Mark]

forgot the important stuff

Excel 2010 in office 2010
windows 7

 

[pile-it Mark]

i have a workbook that i use to send trips to accounting. I have cobbled this together over many years and thought i would try to automate more of it. the data is transferred from written sheets, i just automated the math. new year new sheet, there has to be a better way.

i have asked questions on other posts concerning the relevant ideas.

the only micros i have ever used were given to me from this forum. VBA is a foreign language. i have managed with formulas to this point.

i have a master tab that i copy and add the trip information to. somewhere between 60 and 250 tabs will be added over the year. individual trips.

what i am trying to accomplish:

Cell C2 i would like to be in the Left footer of the individual tabs, this is different for each sheet

if C2 could also use this code (from http://www.mrexcel.com/forum/excel-...ations-code-sheet-name-equal-cell-name-3.html ) to become the tab name for the sheet it is on only it would be fantastic but does not need the cell merge feature c38:n38

Private Sub Worksheet_Change(ByVal Target As Range)
' hiker95, 01/01/2017, ME982790
If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
With Application
.EnableEvents = False
.ScreenUpdating = False
With ActiveSheet
If Not .Range("B2") = vbEmpty Then
.Name = .Range("B2").Value
End If
With .Range("B38")
.Value = Now()
.NumberFormat = "dd-mmm"
End With
With .Range("C38:N38")
.MergeCells = True
.HorizontalAlignment = xlCenter
End With
End With
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

cell N4 i would like to post in the center footer. i have read the posts about the micro to do that and have tried to copy them with no success. this is different for each sheet.

this does code (from http://www.mrexcel.com/forum/excel-questions/434624-page-header-cell-reference.html ) makes them all the same:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
ActiveSheet.PageSetup.LeftHeader = ActiveSheet.Range("$A$1") & Chr(10) & Date
End Sub

i would like line 2 cells B:AE to be added to the totals pages. currently i just create links to the individual cells. this line just pulls the totals off the sheet to a common area.

wondered if this (from http://www.mrexcel.com/forum/excel-...move-rows-another-sheet-based-criteria-2.html ) could be modified to accomplish that.

Option Explicit
Sub DisributeRowsArrays()
' hiker95, 02/14/2014
' http://www.mrexcel.com/forum/excel-...s-move-rows-another-sheet-based-criteria.html
Dim wR As Worksheet, wO As Worksheet, wA As Worksheet, wE As Worksheet
Dim r As Variant, o As Variant, a As Variant, e As Variant
Dim i As Long, lr As Long, rr As Long, oo As Long, aa As Long, ee As Long
Dim n As Long, nr As Long
Set wR = Worksheets("Report")
Set wO = Worksheets("Open")
Set wA = Worksheets("AWC")
Set wE = Worksheets("Escalated")
If wR.FilterMode Then wR.ShowAllData
r = wR.Range("A1").CurrentRegion.Resize(, 6)
n = Application.CountIf(wR.Columns(3), "Open")
ReDim o(1 To n, 1 To 6)
n = Application.CountIf(wR.Columns(3), "AWC")
ReDim a(1 To n, 1 To 6)
n = Application.CountIf(wR.Columns(3), "Escalated")
ReDim e(1 To n, 1 To 6)
For i = 1 To UBound(r, 1)
If r(i, 3) = "Open" Then
oo = oo + 1
o(oo, 1) = r(i, 1)
o(oo, 2) = r(i, 2)
o(oo, 3) = r(i, 3)
o(oo, 4) = r(i, 4)
o(oo, 5) = r(i, 5)
o(oo, 6) = r(i, 6)
ElseIf r(i, 3) = "AWC" Then
aa = aa + 1
a(aa, 1) = r(i, 1)
a(aa, 2) = r(i, 2)
a(aa, 3) = r(i, 3)
a(aa, 4) = r(i, 4)
a(aa, 5) = r(i, 5)
a(aa, 6) = r(i, 6)
ElseIf r(i, 3) = "Escalated" Then
ee = ee + 1
e(ee, 1) = r(i, 1)
e(ee, 2) = r(i, 2)
e(ee, 3) = r(i, 3)
e(ee, 4) = r(i, 4)
e(ee, 5) = r(i, 5)
e(ee, 6) = r(i, 6)
End If
Next i
nr = wO.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
wO.Range("A" & nr).Resize(UBound(o, 1), 6) = o
nr = wA.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
wA.Range("A" & nr).Resize(UBound(a, 1), 6) = a
nr = wE.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
wE.Range("A" & nr).Resize(UBound(e, 1), 6) = e
If wR.FilterMode Then wR.ShowAllData
End Sub


i thought i could use VLookup to grab mileage off the distance tab, but i am struggling trying to search e12 and f 12 to put the distance in j22 from the Distance table B3:E318 the number is in column 4
e13 & f13 would go in k22 they wont all be filled usually.

i would appreciate any help or comments. including formula changes. i need to learn VBA

Thanks,
Mark

a copy of the workbook is located in dropbox link below.

https://www.dropbox.com/s/2w9lr6u80j0i9p6/Mr Excell test.xlsm?dl=0

hope this explains more.

Excel 2010, Windows 7

 

[pile-it Mark]

i found this with a yahoo search:

Default Re: copy of a single row from multiple worksheets into summary sheet within the same workbook

Hiker 95

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:

Option Explicit
Sub Copy2ndRow()
' hiker95, 01/15/2014, ME750730
Dim ws As Worksheet, nr As Long
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Summary" Then
nr = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
ws.Rows(2).Copy Sheets("Summary").Rows(nr)
End If
Next ws
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the Copy2ndRow macro.

i changed it to:


Code:

Option Explicit
Sub Copy2ndRow()
' hiker95, 01/15/2014, ME750730
Dim ws As Worksheet, nr As Long
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "TOTALS" Then
nr = Sheets("TOTALS").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
ws.Rows(2).Copy Sheets("2017 TOTALS").Rows(nr)
End If
Next ws
End Sub


it pulls the 2nd row on the first sheet but does not do the rest. any ideas?

 

[pile-it Mark]

Attention to details... see: http://www.mrexcel.com/forum/excel-...-into-summary-sheet-within-same-workbook.html

one down...

Option Explicit
Sub Copy1stRow()
' hiker95, 01/15/2014, ME750730 Default Re: copy of a single row from multiple worksheets into summary sheet within the same workbook
' modified by pile-it Mark with help from Ashutosh Kumar 01/06/2017
Dim ws As Worksheet, nr As Long
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "2017 TOTALS" _
And Not ws.Name = "distance table" _
And Not ws.Name = "Flight Log 2017 Original" _
And Not ws.Name = "Summary" _
And Not ws.Name = "Master" _
And Not ws.Name = "vba test" Then
nr = Sheets("2017 TOTALS").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
ws.Rows(1).Copy
Sheets("2017 TOTALS").Rows(nr).PasteSpecial Paste:=xlPasteValues
End If
Next ws
End Sub 
[Code]

 

[pile-it Mark]

latest changed test wb. can not get the footer VBA's to work.

https://www.dropbox.com/s/jy608puzx52od1d/MrExcel test2.xlsm?dl=0