Copy data to next clear row on new file

[orsettgreenboy]

Hello, hope someone can help

I have an existing routine that does three things
a) Generates next consecutive number to be added into new file name
b) Saves the file to our nextwork with this new file name
c) Sends me a copy via email.

This works very well see code below:

Sub SvMe() 'Generate next number to B5 and Save filename as value of G9 then save onto P drive and email copy to me
Sheet1.Unprotect Password:="Monkey"
Range("B5") = Range("B5") + 1
 Sheet1.Protect Password:="Monkey"
ActiveWorkbook.Save
    Dim newFile As String, fName As String
 
    fName = Range("G9").Value
    newFile = fName
 
    ActiveWorkbook.SaveAs Filename:="P:\Quality\Non Conformances\" & newFile, FileFormat:=IIf(Application.Version >= "12", 56, -4143)
    Dim wb As Workbook
    Dim I As Long
    Set wb = ActiveWorkbook
    If Val(Application.Version) >= 12 Then
        If wb.FileFormat = 51 And wb.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file, there will" & vbNewLine & _
                   "be no VBA code in the file you send. Save the" & vbNewLine & _
                   "file first as xlsm and then try the macro again.", vbInformation
            Exit Sub
        End If
    End If
    On Error Resume Next
    For I = 1 To 3
        wb.SendMail "[EMAIL="rg@xxx.co.uk"]rg@xxx.co.uk[/EMAIL]", _
                    "Non Conformance"
        If Err.Number = 0 Then Exit For
    Next I
    On Error GoTo 0
  End Sub

However, I now also need to copy the new file name together with certain cells contents to a third sheet which will be a log. Therefore the data copying over will need to be added to the next clear row available.

So to be clear there will be 3 files altogether
1) The original file (like a template / form for the user to fill out)
2) The saved as file (with a new file name each time)
3) The third is a file (a kind of log) which will receive the data from 2)


The new (third file) will have headings in Row A.

So the file name (from the second file) will need to be copied to Cell A2 the first time (if row 2 is clear), and next time to Cell A3, and so on.

Also the contents of cells B5,B7,B9,B11,B13,B15,B17,B19,B21,B23,B25,B27,B29,B31 & B33 will also need to be copied into the same row as the filename, starting at column B for B5, and column C for B7 etc.

I do hope I've explained that with enough information without being too longwinded!

Thanks for any help

 

[daverunt]

Hi,

not sure about some of the details so I have assumed some code you will need to change.
Log.xls exists in c:\junk
You seem to be using the Range B5 for part of the filename and also as part of the range to be copied?

I hope there's enough here for you to get it working as required.

Sub SvMe() 'Generate next number to B5 and Save filename as value of G9 then save onto P drive and email copy to me
Sheet1.Unprotect Password:="Monkey"
Range("B5") = Range("B5") + 1
 Sheet1.Protect Password:="Monkey"
ActiveWorkbook.Save
    Dim newFile As String, fName As String
 
    fName = Range("G9").Value
    newFile = fName
 
    ActiveWorkbook.SaveAs Filename:="P:\Quality\Non Conformances\" & newFile, FileFormat:=IIf(Application.Version >= "12", 56, -4143)
    Dim wb As Workbook
    Dim I As Long
    Set wb = ActiveWorkbook
[COLOR=darkred]Set Rng = Range("B5:B5,B7,B9,B11,B13,B15,B17,B19,B21,B23,B25,B27,B29,B31,B33")[/COLOR]
    If Val(Application.Version) >= 12 Then
        If wb.FileFormat = 51 And wb.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file, there will" & vbNewLine & _
                   "be no VBA code in the file you send. Save the" & vbNewLine & _
                   "file first as xlsm and then try the macro again.", vbInformation
            Exit Sub
        End If
    End If
 
[COLOR=darkred]   Nme = wb.Name[/COLOR]
[COLOR=darkred]   Workbooks.Open [COLOR=red]("C:\junk\Log.xls")[/COLOR]
    Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
    Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
    Loop
    ActiveCell.Value = Nme
    Rw = ActiveCell.Row
 
    col = 1
    For Each Dn In Rng
    Range("A" & Rw).Offset(0, col).Value = Dn.Value
    col = col + 1
    Next[/COLOR]
 
 
    On Error Resume Next
    For I = 1 To 3
        wb.SendMail "[EMAIL="rg@xxx.co.uk"][COLOR=#304c6c]rg@xxx.co.uk[/COLOR][/EMAIL]", _
                    "Non Conformance"
        If Err.Number = 0 Then Exit For
    Next I
    On Error GoTo 0
  End Sub

 

[orsettgreenboy]

Well thanks for your great help daverunt

You are correct in saying that the Range B5 is part of the filename and also part of the range to be copied, that is intentional & hope this is okay.

I have changed the "third" filename & path, but when this file opens nothing is pasted into the file for some reason, and the routine stops here.

I just don't know where to go from here, sorry, can you help?

Update as below:

Sub SvMe() 'Generate next number to B5 and Save filename as value of G9 then save onto P drive and email copy to me
Sheet1.Unprotect Password:="Monkey"
Range("B5") = Range("B5") + 1
 Sheet1.Protect Password:="Monkey"
ActiveWorkbook.Save
    Dim newFile As String, fName As String
 
    fName = Range("G9").Value
    newFile = fName
 
    ActiveWorkbook.SaveAs Filename:="P:\Quality\Non Conformances\" & newFile, FileFormat:=IIf(Application.Version >= "12", 56, -4143)
    Dim wb As Workbook
    Dim I As Long
    Set wb = ActiveWorkbook
Set Rng = Range("B5:B5,B7,B9,B11,B13,B15,B17,B19,B21,B23,B25,B27,B29,B31,B33")
    If Val(Application.Version) >= 12 Then
        If wb.FileFormat = 51 And wb.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file, there will" & vbNewLine & _
                   "be no VBA code in the file you send. Save the" & vbNewLine & _
                   "file first as xlsm and then try the macro again.", vbInformation
            Exit Sub
        End If
    End If
 
   Nme = wb.Name
   Workbooks.Open ("P:\Quality\Non Conformances\Non Conformance Log.xls")
    Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
    Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
    Loop
    ActiveCell.Value = Nme
    Rw = ActiveCell.Row
 
    col = 1
    For Each Dn In Rng
    Range("A" & Rw).Offset(0, col).Value = Dn.Value
    col = col + 1
    Next
 
 
    On Error Resume Next
    For I = 1 To 3
        wb.SendMail "[EMAIL="rg@xxxx.co.uk"]rg@xxxx.co.uk[/EMAIL]", _
                    "Non Conformance"
        If Err.Number = 0 Then Exit For
    Next I
    On Error GoTo 0
  End Sub

 

[daverunt]

I'm not sure why it's not working....What I have cobbled here is but that may be because I misunderstand what is happening.

I spotted 1 typo
Set Rng = Range("B5:B5,B7
should be Set Rng = Range("B5, B7, etc)

You should step through the code in the Editor using F8 to see what is happening or not as the case may be. It may be the log file isn't active once opened and you should spot that. You can also hover over the code and see what the values are on the previous lines as you step through them.


Try running a copy locally setting c:\junk as the filepaths in your code and dumping the files in there.