rey06
02-18-2016, 07:49 AM
Hi - I'm sure my subject line is super confusing, but I can explain.
I have the below code (thanks to help I got here!) that makes wonderful reports and exports them to a new location.
However, they are being exported with several blank lines where there was once a formula. I don't think Excel is seeing them as blank lines though, which might be a problem. Is there a way to alter the below code to remove those blank lines?
Previous forum - http://www.vbaexpress.com/forum/showthread.php?55166-Move-data-from-one-sheet-to-another-and-export&p=338412#post338412
Code
Option Explicit
Sub DiscrepancyReport()
Dim Wb As Workbook
Dim xWs As Worksheet
Dim DateBox As String
Dim xPath As String
xPath = ThisWorkbook.Path
DateBox = InputBox("DISCREPANCY REPORTS: Please enter the date YYYYMM")
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
If xWs.Name <> "MACROS" And xWs.Name <> "Flat File" And xWs.Name <> "DisInput" And xWs.Name <> "DisReport" Then
xWs.Cells.Copy Sheets("DisInput").Range("A1")
Application.Calculate
Sheets("DisReport").Copy
With ActiveSheet.Cells
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" _
& DateBox & "_" _
& Sheets("DisReport").Range("AK2") _
& "_Discrepancy Report" & ".xlsx"
Application.ActiveWorkbook.Close False
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
ThisWorkbook.Activate
End Sub
I have the below code (thanks to help I got here!) that makes wonderful reports and exports them to a new location.
However, they are being exported with several blank lines where there was once a formula. I don't think Excel is seeing them as blank lines though, which might be a problem. Is there a way to alter the below code to remove those blank lines?
Previous forum - http://www.vbaexpress.com/forum/showthread.php?55166-Move-data-from-one-sheet-to-another-and-export&p=338412#post338412
Code
Option Explicit
Sub DiscrepancyReport()
Dim Wb As Workbook
Dim xWs As Worksheet
Dim DateBox As String
Dim xPath As String
xPath = ThisWorkbook.Path
DateBox = InputBox("DISCREPANCY REPORTS: Please enter the date YYYYMM")
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
If xWs.Name <> "MACROS" And xWs.Name <> "Flat File" And xWs.Name <> "DisInput" And xWs.Name <> "DisReport" Then
xWs.Cells.Copy Sheets("DisInput").Range("A1")
Application.Calculate
Sheets("DisReport").Copy
With ActiveSheet.Cells
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" _
& DateBox & "_" _
& Sheets("DisReport").Range("AK2") _
& "_Discrepancy Report" & ".xlsx"
Application.ActiveWorkbook.Close False
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
ThisWorkbook.Activate
End Sub