Excel VBA- Copying data from newest worksheet to a new workbook

Posts
1
Registration date
Wednesday January 30, 2019
Status
Member
Last seen
January 30, 2019
- - Latest reply:  1aman1diot - Jan 30, 2019 at 01:12 PM
Hi all,

Newbie here. I've been fumbling around with VBA and managed to get some parts working, but now I'm stumped.

I have an Excel workbook that gets used for field data collection (Snow Survey Sheets). Every time a technician goes out, a new worksheet (named as the current date) is added to the workbook. This worksheet contains 5 tables which summarize the field data as an average depth, total water equivalent, and site conditions. The summarized field data collected needs to then be entered into a new workbook in a specific format for submission. I'd like to be able to automate the data export to the new workbook.

Right now, I have an export button on the field form in Snow Survey Sheets, that creates a new workbook in the same location as the field form, names it as the current date, and has the submission template set-up. I can't seem to get it to copy over the specific cells with the data I require though. I don't get an error message, it just populates the template with zeroes.

Any help on figuring this out would be appreciated. I've pasted the code below. I apologize in advance, it's probably quite cumbersome, but I'm very new to this have jumped into the deep end of the pool instead of starting with the basics due to time restrictions.

Sub AddNew()
Set NewBook = Workbooks.Add
With NewBook
.Title = "Snow Data"
.Subject = "Snow Data to be Submitted"
.SaveAs Filename:="Snow Data_" & Format(Date, "yyyy-mm-dd") & ".xlsx"
End With

With ThisWorkbook

' Submission template formatting

NewBook.Sheets("Sheet1").Columns("A").ColumnWidth = 29
NewBook.Sheets("Sheet1").Columns("B").ColumnWidth = 15
NewBook.Sheets("Sheet1").Columns("I").ColumnWidth = 15
NewBook.Sheets("Sheet1").Columns("K").ColumnWidth = 29

NewBook.Sheets("Sheet1").Range("A1").Value = "_code"
NewBook.Sheets("Sheet1").Range("B1").Value = "date"
NewBook.Sheets("Sheet1").Range("C1").Value = "year"
NewBook.Sheets("Sheet1").Range("D1").Value = "month"
NewBook.Sheets("Sheet1").Range("E1").Value = "day"
NewBook.Sheets("Sheet1").Range("F1").Value = "SD"
NewBook.Sheets("Sheet1").Range("G1").Value = "SWE"
NewBook.Sheets("Sheet1").Range("H1").Value = "crust"
NewBook.Sheets("Sheet1").Range("I1").Value = "soil_condition"
NewBook.Sheets("Sheet1").Range("J1").Value = "flag"
NewBook.Sheets("Sheet1").Range("A1:J1").Interior.ColorIndex = 15
NewBook.Sheets("Sheet1").Range("A1:J1").HorizontalAlignment = xlCenter

NewBook.Sheets("Sheet1").Range("A2:A6").Font.Bold = True
NewBook.Sheets("Sheet1").Range("A2:A6").HorizontalAlignment = xlCenter
NewBook.Sheets("Sheet1").Range("A2").Value = "SNOW-4701"
NewBook.Sheets("Sheet1").Range("A3").Value = "SNOW-4802"
NewBook.Sheets("Sheet1").Range("A4").Value = "SNOW-4902"
NewBook.Sheets("Sheet1").Range("A5").Value = "SNOW-4903"
NewBook.Sheets("Sheet1").Range("A6").Value = "SNOW-4904"

NewBook.Sheets("Sheet1").Range("B2:B6").HorizontalAlignment = xlCenter
NewBook.Sheets("Sheet1").Range("B2").Value = Format(Date, "yyyy-mm-dd")
NewBook.Sheets("Sheet1").Range("B3").Value = Format(Date, "yyyy-mm-dd")
NewBook.Sheets("Sheet1").Range("B4").Value = Format(Date, "yyyy-mm-dd")
NewBook.Sheets("Sheet1").Range("B5").Value = Format(Date, "yyyy-mm-dd")
NewBook.Sheets("Sheet1").Range("B6").Value = Format(Date, "yyyy-mm-dd")

NewBook.Sheets("Sheet1").Range("C2:C6").HorizontalAlignment = xlCenter
NewBook.Sheets("Sheet1").Range("C2").Value = Format(Date, "yyyy")
NewBook.Sheets("Sheet1").Range("C3").Value = Format(Date, "yyyy")
NewBook.Sheets("Sheet1").Range("C4").Value = Format(Date, "yyyy")
NewBook.Sheets("Sheet1").Range("C5").Value = Format(Date, "yyyy")
NewBook.Sheets("Sheet1").Range("C6").Value = Format(Date, "yyyy")

NewBook.Sheets("Sheet1").Range("D2:D6").HorizontalAlignment = xlCenter
NewBook.Sheets("Sheet1").Range("D2").Value = Format(Date, "mm")
NewBook.Sheets("Sheet1").Range("D3").Value = Format(Date, "mm")
NewBook.Sheets("Sheet1").Range("D4").Value = Format(Date, "mm")
NewBook.Sheets("Sheet1").Range("D5").Value = Format(Date, "mm")
NewBook.Sheets("Sheet1").Range("D6").Value = Format(Date, "mm")

NewBook.Sheets("Sheet1").Range("E2:E6").HorizontalAlignment = xlCenter
NewBook.Sheets("Sheet1").Range("E2").Value = Format(Date, "dd")
NewBook.Sheets("Sheet1").Range("E3").Value = Format(Date, "dd")
NewBook.Sheets("Sheet1").Range("E4").Value = Format(Date, "dd")
NewBook.Sheets("Sheet1").Range("E5").Value = Format(Date, "dd")
NewBook.Sheets("Sheet1").Range("E6").Value = Format(Date, "dd")

NewBook.Sheets("Sheet1").Range("J2:J6").HorizontalAlignment = xlCenter
NewBook.Sheets("Sheet1").Range("J2").Value = "1"
NewBook.Sheets("Sheet1").Range("J3").Value = "1"
NewBook.Sheets("Sheet1").Range("J4").Value = "1"
NewBook.Sheets("Sheet1").Range("J5").Value = "1"
NewBook.Sheets("Sheet1").Range("J6").Value = "1"

NewBook.Sheets("Sheet1").Range("K2:K6").HorizontalAlignment = xlCenter
NewBook.Sheets("Sheet1").Range("K2").Value = "Ashburn/ Crow's Pass"
NewBook.Sheets("Sheet1").Range("K3").Value = "Purple Woods"
NewBook.Sheets("Sheet1").Range("K4").Value = "Stephen's Gulch"
NewBook.Sheets("Sheet1").Range("K5").Value = "Long Sault"
NewBook.Sheets("Sheet1").Range("K6").Value = "Heber Down"

NewBook.Sheets("Sheet1").Range("A21").Value = "Field definitions are as follows:"
NewBook.Sheets("Sheet1").Range("A22").Value = "FIELD NAME"
NewBook.Sheets("Sheet1").Range("A23").Value = "code"
NewBook.Sheets("Sheet1").Range("A24").Value = "Date"
NewBook.Sheets("Sheet1").Range("A25").Value = "Year"
NewBook.Sheets("Sheet1").Range("A26").Value = "Month"
NewBook.Sheets("Sheet1").Range("A27").Value = "Day"
NewBook.Sheets("Sheet1").Range("A28").Value = "SD"
NewBook.Sheets("Sheet1").Range("A29").Value = "SWE"
NewBook.Sheets("Sheet1").Range("A30").Value = "CRUST"
NewBook.Sheets("Sheet1").Range("A32").Value = "Soil_condition"
NewBook.Sheets("Sheet1").Range("A33").Value = "Flag"
NewBook.Sheets("Sheet1").Range("B22").Value = "Notes"
NewBook.Sheets("Sheet1").Range("B23").Value = "1 line per station, case sensitive, must be a valid WISKI Station number."
NewBook.Sheets("Sheet1").Range("B24").Value = "The date of the sample, with no restrictions on format"
NewBook.Sheets("Sheet1").Range("B25").Value = "A 4 digit numerical value for the year of the sample."
NewBook.Sheets("Sheet1").Range("B26").Value = "A 2 digit numerical value for the month of the sample; use 11 for November."
NewBook.Sheets("Sheet1").Range("B27").Value = "A 1 or 2 digit numerical value for the day the sample was taken."
NewBook.Sheets("Sheet1").Range("B28").Value = "Average depth of snow at the station; measured in either CM or 1/10ths of inches; decimal values are accepted."
NewBook.Sheets("Sheet1").Range("B29").Value = "Average water equivalent of snow at the station; measured in either MM or 1/10ths of inches; decimal values are accepted."
NewBook.Sheets("Sheet1").Range("B30").Value = "Crust conditions at the snow course; the field will accept several characters of text or numbers; expected values are either A or B or C or D."
NewBook.Sheets("Sheet1").Range("C31").Value = "A: no crust B:light crust C:snowshoe crust D:man crust"
NewBook.Sheets("Sheet1").Range("B32").Value = "Soil conditions at the snow course; the field will accept several characters of text or numbers; expected values are UD – unfrozen dry, UW – unfrozen wet, or F – frozen."
NewBook.Sheets("Sheet1").Range("B33").Value = "A numeric value is expected; either 0 or 1;"
NewBook.Sheets("Sheet1").Range("B34").Value = "A flag value of ZERO (0) denotes measurements of snow depth and water equivalent are IMPERIAL: 10ths of inches of snow depth and water equivalent;"
NewBook.Sheets("Sheet1").Range("B35").Value = "A flag value of ONE (1) indicates measurements are in METRIC: CM of snow depth and MM of water equivalent."


End With

'Copy Snow Data From Field Form into Submission Form

'Heber

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("K17").Copy

End With

NewBook.Sheets("Sheet1").Range("F6").PasteSpecial xlPasteValues

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("N16").Copy

End With

NewBook.Sheets("Sheet1").Range("G6").PasteSpecial xlPasteValues

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("O9").Copy

End With

NewBook.Sheets("Sheet1").Range("H6").PasteSpecial

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("P9").Copy

End With

NewBook.Sheets("Sheet1").Range("I6").PasteSpecial

'Crow's Pass

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("B35").Copy

End With

NewBook.Sheets("Sheet1").Range("F2").PasteSpecial xlPasteValues

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("E34").Copy

End With

NewBook.Sheets("Sheet1").Range("G2").PasteSpecial xlPasteValues

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("F27").Copy

End With

NewBook.Sheets("Sheet1").Range("H2").PasteSpecial

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("G27").Copy

End With

NewBook.Sheets("Sheet1").Range("I2").PasteSpecial

'Purplewoods

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("K35").Copy

End With

NewBook.Sheets("Sheet1").Range("F3").PasteSpecial xlPasteValues

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("N34").Copy

End With

NewBook.Sheets("Sheet1").Range("G3").PasteSpecial xlPasteValues

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("O27").Copy

End With

NewBook.Sheets("Sheet1").Range("H3").PasteSpecial

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("P27").Copy

End With

NewBook.Sheets("Sheet1").Range("I3").PasteSpecial

'Long Sault

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("B53").Copy

End With

NewBook.Sheets("Sheet1").Range("F5").PasteSpecial xlPasteValues

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("E52").Copy

End With

NewBook.Sheets("Sheet1").Range("G5").PasteSpecial xlPasteValues

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("F45").Copy

End With

NewBook.Sheets("Sheet1").Range("H5").PasteSpecial

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("G45").Copy

End With

NewBook.Sheets("Sheet1").Range("I5").PasteSpecial

'Stephen's Gulch

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("K53").Copy

End With

NewBook.Sheets("Sheet1").Range("F4").PasteSpecial xlPasteValues

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("N52").Copy

End With

NewBook.Sheets("Sheet1").Range("G4").PasteSpecial xlPasteValues

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("O45").Copy

End With

NewBook.Sheets("Sheet1").Range("H4").PasteSpecial

With ThisWorkbook

ThisWorkbook.Sheets(Worksheets.Count).Range("P45").Copy

End With

NewBook.Sheets("Sheet1").Range("I4").PasteSpecial


End Sub
See more 

Your reply

1 reply

0
Thank you
Instead of calling the workbook by name, select it. Then instead of pointing to newbook, point to activeworkbook.
Respond to 1aman1diot