Insert last day of previous month, copy and paste to next empty row

[maratonomak1]

Hi,

I have a code to copy and paste to next empty row from workbook X to Y column B(+3). I'm trying to insert the last day of previous month format (MMDDYY) but in column A . So if the next empty row pasted in cell B20 to insert the last day of previous month only in A20. My code so far.

Sub Copy()

ThisWorkbook.RefreshAll
Application.CalculateUntilAsyncQueriesDone
Application.CalculateFullRebuild
Application.CalculateUntilAsyncQueriesDone

Dim SourceBk As Workbook, DestBk As Workbook
Dim Sh As Worksheet
Dim pasterow As Long
Dim lo As Excel.ListObject

Set SourceBk = ThisWorkbook 'X"
Set DestBk = Workbooks("Y.xlsm")

Application.ScreenUpdating = False

For Each Sh In ThisWorkbook.Worksheets
pasterow = DestBk.Sheets(Sh.Name).Cells(Rows.Count, "B").End(xlUp).Row + 3
With SourceBk.Sheets(Sh.Name)
If .Range("A2") <> "" Then
Set lo = .ListObjects(1)
With lo
.Range.Copy
DestBk.Sheets(Sh.Name).Range("B" & pasterow).PasteSpecial xlPasteFormats
DestBk.Sheets(Sh.Name).Range("B" & pasterow).PasteSpecial xlPasteValuesAndNumberFormats
End With
Else
DestBk.Sheets(Sh.Name).Range("B" & pasterow).Value = "N/A"
End If
End With
Next Sh

Application.CutCopyMode = False

Set SourceBk = Nothing
Set DestBk = Nothing

Application.ScreenUpdating = True

End Sub

Any help will be greatly appreciated.

Thanks!

 

[JLGWhiz]

see if this will work for you.

Sub Copy()
 ThisWorkbook.RefreshAll
 Application.CalculateUntilAsyncQueriesDone
 Application.CalculateFullRebuild
 Application.CalculateUntilAsyncQueriesDone
 Dim SourceBk As Workbook, DestBk As Workbook
 Dim Sh As Worksheet
 Dim pasterow As Long
 Dim lo As Excel.ListObject
 Set SourceBk = ThisWorkbook 'X"
 Set DestBk = Workbooks("Y.xlsm")
 Application.ScreenUpdating = False
    For Each Sh In ThisWorkbook.Worksheets
        pasterow = DestBk.Sheets(Sh.Name).Cells(Rows.Count, "B").End(xlUp).Row + 3
            With SourceBk.Sheets(Sh.Name)
                If .Range("A2") <> "" Then
                    Set lo = .ListObjects(1)
                    With lo
                        .Range.Copy
                        DestBk.Sheets(Sh.Name).Range("B" & pasterow).PasteSpecial xlPasteFormats
                        DestBk.Sheets(Sh.Name).Range("B" & pasterow).PasteSpecial xlPasteValuesAndNumberFormats
                        [COLOR="#0000CD"]DestBk.Sheets(Sh.Name).Range("A" & pasterow) = Format(Date - Day(Date), "mmddyy")[/COLOR]                   
                    End With
                Else
                    DestBk.Sheets(Sh.Name).Range("B" & pasterow).Value = "N/A"
                End If
            End With
    Next Sh
 Application.CutCopyMode = False
 Set SourceBk = Nothing
 Set DestBk = Nothing
 Application.ScreenUpdating = True
 End Sub

 

[maratonomak1]

see if this will work for you.

That was quick and fast. Thank you so much.

I hate to ask off topic. I'm copying and pasting tables between workbooks, table header keeps the original format but the body format changes. Although I use xlPasteFormats and xlPasteValuesAndNumberFormats.

Thanks again !!!

 

[maratonomak1]

Another thing that I noticed is that for the empty sheets destbk has N/A in column B

 Else
                DestBk.Sheets(Sh.Name).Range("B" & pasterow).Value = "N/A"
            End If

In these sheets, the date is missing.

DestBk.Sheets(Sh.Name).Range("A" & pasterow) = Format(Date - Day(Date), "mmddyy")

But works great on other sheets that contain tables.

Thanks again.

 

[JLGWhiz]

That was quick and fast. Thank you so much.

I hate to ask off topic. I'm copying and pasting tables between workbooks, table header keeps the original format but the body format changes. Although I use xlPasteFormats and xlPasteValuesAndNumberFormats.

Thanks again !!!

Not positive it will work, but try reversing the order in which you paste. Paste values first, then formats.
Regards, JLG

 

[JLGWhiz]

Another thing that I noticed is that for the empty sheets destbk has N/A in column B

 Else
                DestBk.Sheets(Sh.Name).Range("B" & pasterow).Value = "N/A"
            End If

In these sheets, the date is missing.

DestBk.Sheets(Sh.Name).Range("A" & pasterow) = Format(Date - Day(Date), "mmddyy")

But works great on other sheets that contain tables.

Thanks again.

Yes, the code is executing exactly as written. Your origingal post did not mention empty sheets.

See if this helps.

Sub Copy()
 ThisWorkbook.RefreshAll
 Application.CalculateUntilAsyncQueriesDone
 Application.CalculateFullRebuild
 Application.CalculateUntilAsyncQueriesDone
 Dim SourceBk As Workbook, DestBk As Workbook
 Dim Sh As Worksheet
 Dim pasterow As Long
 Dim lo As Excel.ListObject
 Set SourceBk = ThisWorkbook 'X"
 Set DestBk = Workbooks("Y.xlsm")
 Application.ScreenUpdating = False
    For Each Sh In ThisWorkbook.Worksheets
	[COLOR="#FF0000"]If sh.UsedRange.Rows.Count > 1 Then[/COLOR]        
         pasterow = DestBk.Sheets(Sh.Name).Cells(Rows.Count, "B").End(xlUp).Row + 3
            With SourceBk.Sheets(Sh.Name)
                If .Range("A2") <> "" Then
                    Set lo = .ListObjects(1)
                    With lo
                        .Range.Copy
                        DestBk.Sheets(Sh.Name).Range("B" & pasterow).PasteSpecial xlPasteFormats
                        DestBk.Sheets(Sh.Name).Range("B" & pasterow).PasteSpecial xlPasteValuesAndNumberFormats
                        DestBk.Sheets(Sh.Name).Range("A" & pasterow) = Format(Date - Day(Date), "mmddyy")                   
                    End With
                Else
                    DestBk.Sheets(Sh.Name).Range("B" & pasterow).Value = "N/A"
                End If
            End With
       [COLOR="#FF0000"] End If[/COLOR]    Next Sh
 Application.CutCopyMode = False
 Set SourceBk = Nothing

 

[maratonomak1]

If sh.UsedRange.Rows.Count > 1 Then

It won't insert the date in column A and N/A in column B

When I change to

If sh.UsedRange.Rows.Count > 0 Then

I get N/A but not the date.
FYI, the table on workbook X is refreshed from access db so usedrange.rows is always >1:

ThisWorkbook.RefreshAll
 Application.CalculateUntilAsyncQueriesDone
 Application.CalculateFullRebuild
 Application.CalculateUntilAsyncQueriesDone

 

[JLGWhiz]

If sh.UsedRange.Rows.Count > 1 Then

It won't insert the date in column A and N/A in column B

When I change to

If sh.UsedRange.Rows.Count > 0 Then

I get N/A but not the date.
FYI, the table on workbook X is refreshed from access db so usedrange.rows is always >1:

ThisWorkbook.RefreshAll
 Application.CalculateUntilAsyncQueriesDone
 Application.CalculateFullRebuild
 Application.CalculateUntilAsyncQueriesDone

All that last modification did was eliminate blank sheets from executing at all. Why do you even need the NA if you are not working with a table? The lo variable is for a list item object only, so if you don't have a named list on the sheet, why would you care?

 

[maratonomak1]

All that last modification did was eliminate blank sheets from executing at all. Why do you even need the NA if you are not working with a table? The lo variable is for a list item object only, so if you don't have a named list on the sheet, why would you care?

This is something I have to keep track of inputs every month where there is a table or not. Any suggestion you may have when the table is empty? The n/a is not a problem, the date is more important.
Thanks for your help !

 

[JLGWhiz]

This is something I have to keep track of inputs every month where there is a table or not. Any suggestion you may have when the table is empty? The n/a is not a problem, the date is more important.
Thanks for your help !

If all you want to do is add the date then modify your Else statement:

       Else
           DestBk.Sheets(Sh.Name).Range("B" & pasterow).Value = "N/A"
           [COLOR="#0000CD"]DestBk.Sheets(Sh.Name).Range("A" & pasterow) = Format(Date - Day(Date), "mmddyy")  [/COLOR]
       End If

And delete the If...End If Statement for the UsedRange.