Cut and Paste to another work sheet

[NZAS]

Hi
I would like a macro/VBA code

to be able to Cut the data from range A6:a8 (has a formula to populate the values) on worksheet ABC then to paste as values to the next empty row on worksheet CDE in column B then have a message box say data copied. eg paste values to B12345 which is the next empty row etc, etc in worksheet CDE

Also if there is data in range A6:a8 on worksheet ABC when file is closed that it stops the user from closing the file until the range A6:A8 on worksheet ABC does not have data in them.

This workbook is populated on a very regular basis and I wish to take away all the manual work to do this. The above is manually done and takes time. I though using a Macro/VBA would help
Hope you can help with these. I do not know much about Marco/VBA
Thanks in advance

 

[L. Howard]

Hi
I would like a macro/VBA code

to be able to Cut the data from range A6:a8 (has a formula to populate the values) on worksheet ABC then to paste as values to the next empty row on worksheet CDE in column B then have a message box say data copied. eg paste values to B12345 which is the next empty row etc, etc in worksheet CDE

Also if there is data in range A6:a8 on worksheet ABC when file is closed that it stops the user from closing the file until the range A6:A8 on worksheet ABC does not have data in them.

This workbook is populated on a very regular basis and I wish to take away all the manual work to do this. The above is manually done and takes time. I though using a Macro/VBA would help
Hope you can help with these. I do not know much about Marco/VBA
Thanks in advance

Hi NZAS,

This in ABC sheet module will make the copies to DEF.

Option Explicit

Sub ABC_DEF()

Range("A6:A8").Copy
Sheets("DEF").Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial (xlPasteValues)

End Sub

Now, what do you want to do with the formulas that reside in A6:A8??

Howard

 

[NZAS]

Sorry I forgot they were on value the formula are in other cells

 

[NZAS]

Sorry I forgot they were only values the formula are in other cells

Thanks L. Howard your code has worked

Just need help on the other.

if there is no data in range a1:a200 on worksheet ABC when file is closed that it stops from closing the file until the data has been populated in blank cells on worksheet ABC.

Cheers
NZAS

 

[L. Howard]

Thanks L. Howard your code has worked

Just need help on the other.

if there is no data in range a1:a200 on worksheet ABC when file is closed that it stops from closing the file until the data has been populated in blank cells on worksheet ABC.

Cheers
NZAS

See if this works for you. It is a Before_Save event which I believe will cover your bases on the 200 A column cells.

This will go in the ThisWorkbook code module.

Howard

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim myCnt As Long, Diff As Long

myCnt = Application.CountA(Sheets("ABC").Range("A1:A200"))
Diff = 200 - myCnt
If Not Me.Saved Then
   If Diff > 0 Then
      
      MsgBox "Cells A1 to A200 must have values before " _
             & vbCr & "      the workbook is closed or saved!" _
             & vbCr & vbCr & _
             "                   " & Diff & " cells are empty!"
      
      Cancel = True
   End If
End If
End Sub

 

[NZAS]

Hi Howard
Thanks for the code for this it works fine. I should have also asked can the empty cells be listed. I was not aware you would set up a message box to show up. This would make it easier to find the error i.e. empty cells.
Thanks NZAS

 

[L. Howard]

Hi Howard
Thanks for the code for this it works fine. I should have also asked can the empty cells be listed. I was not aware you would set up a message box to show up. This would make it easier to find the error i.e. empty cells.
Thanks NZAS

Hi NZAS,

Discard the previous Before_Save code and replace it in the ThisWorhbook module with this.

Howard

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim myCnt As Long, Diff As Long
Dim OneRng As Range, c As Range, sBlanks$, vMsg

myCnt = Application.CountA(Sheets("ABC").Range("A1:A200"))
Diff = 200 - myCnt
If Not Me.Saved Then
   If Diff > 0 Then
      
      MsgBox "Cells A1 to A200 must have values before " _
             & vbCr & "      the workbook is closed or saved!" _
             & vbCr & vbCr & _
             "                   " & Diff & " cells are empty!", vbExclamation
      
      Cancel = True
   End If
End If

Set OneRng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
  On Error GoTo ErrExit

  For Each c In OneRng.SpecialCells(xlCellTypeBlanks)
    sBlanks = sBlanks & "|" & c.Address
  Next 'c

ErrExit:
  If Err = 0 Then

    vMsg = "These cells are blank:" & vbLf & vbLf
    vMsg = vMsg & Join(Split(Mid(sBlanks, 2), "|"), vbLf)
  Else
    Exit Sub
    'vMsg = "No blanks found"
  End If

  MsgBox vMsg, vbInformation

End Sub

 

[L. Howard]

Hi NZAS,

The code in post #7 works fairly well for the most part.

It does have some short comings.

I have a revised version in the mill, will post it soon.

Howard

 

[L. Howard]

Hi NZAS,

The code in post #7 works fairly well for the most part.

It does have some short comings.

I have a revised version in the mill, will post it soon.

Howard

Hi NZAS,

Give this a try, goes in the ThisWorkbook module. (Discard the old version entirely)

This portion of the code will need to be modified by you should you want to change the number of rows in column A, currently set at 200.

'// Modify the LastRow value to the expected last row number in column A
Const LastRow = 200

If the number of rows does change on your sheet, then you will need to change the 200 to the new number of rows.

That is all you need to do.

Howard

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim myCnt As Long, Diff As Long
Dim OneRng As Range, rngC As Range, sBlanks$, vMsg


'// Modify the LastRow value to the expected last row number in column A
Const LastRow = [COLOR="#FF0000"]200[/COLOR]

Set OneRng = Range("A1:A" & LastRow)
myCnt = Application.CountA(OneRng)
If Len(Cells(LastRow + 1, 1)) = 0 Then Cells(LastRow + 1, 1) = "**End**"


Diff = LastRow - myCnt
If Not ThisWorkbook.Saved Then
    If Diff > 0 Then
        Cancel = True

        MsgBox "Cells A1 to A" & LastRow & " " & _
               " must have values before " _
               & vbCr & "      the workbook is closed or saved!" _
               & vbCr & vbCr & _
               "                   " & Diff & _
               " cells are empty!", vbExclamation, "Blank Cells Alert"
        

        sBlanks = OneRng.SpecialCells(xlCellTypeBlanks).Address(0, 0)
        sBlanks = Join(Split(sBlanks, ","), Chr(10))
        vMsg = "Blanks cells are:" & vbLf & vbLf & sBlanks
   End If
End If

If Len(vMsg) <> 0 Then
  MsgBox vMsg, vbInformation
End If

End Sub

 

[NZAS]

Thanks Howard
Does the trick for me