Macro to copy a non-blank row

Occasional Contributor
  1. I have an excel file with multiple tabs and I want to create a macro that goes to the tab "Import Data" that contains 5000 rows with formulas not necessarily data columns A to P on this example 108 rows but can be more than that. Go to the "Temp" tab delete all data and go back to the Import Data copy all the 108 rows (that is variable next time can be 110 or  and then past them as values in the temp tab. When I try to work around and copy and paste the entire cell and delete the duplicates always leave one blank one and access have problems import the files. Any help?
6 Replies
It sounds like a linked sheet in your Access file might be better. Can you upload an example so we can see the problem more clearly?

Import Data Tab.JPGTemp Tab.JPG

Can you add the code you are using at the moment?
Sub Clean()
' Clean Macro

Selection.Delete Shift:=xlUp
Sheets("Import Data").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$P$5000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16), Header:=xlYes
Sheets("Order Information").Select
Application.Run "'Laser Marking Traveler.xlsm'!Range_End_Method"
Sheets("Order Information").Select
End Sub

and then

Sub Range_End_Method()
'Finds the last non-blank cell in a single row or column
Dim lRow As Long
Dim lCol As Long
'Find the last non-blank cell in column A(1)
lRow = Cells(rows.Count, 1).End(xlUp).Row
'Find the last non-blank cell in row 1
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
End Sub



As I've understood your code, it should do the following:


  • Remove all data from the Temp sheet
  • Copy the data starting in cell A1 of the Import data sheet
  • Paste that data as values on the Temp sheet
  • Remove duplicates from the pasted data
  • Autofit the columns of the pasted data
  • Delete the last row of the pasted data
  • Save the workbook




If I've understood correctly, then please try this:



Option Explicit
Public Sub Clean()

    Dim wb As Workbook
    Dim wsTemp As Worksheet
    Dim wsImportData As Worksheet
    Dim rng As Range
    Set wb = ThisWorkbook
    Set wsTemp = wb.Worksheets("Temp")
    Set wsImportData = wb.Worksheets("Import Data")
    'clear the temp sheet, then paste as values
    With wsTemp
        'get the data to be copied
        'must be done after .Cells.Clear as this deactivates the copy
        .Range("A1").PasteSpecial xlPasteValues
        Set rng = .Range("A1").CurrentRegion
    End With

    'remove dupes, autofit and delete last row
    rng.RemoveDuplicates Header:=xlYes

    'save the workbook
End Sub



Please note that if your data on the "Import Data" sheet does not start in cell A1 and possible contains entirely blank rows or columns between non-blank rows or columns, then you should replace this line:






With something like this:



Dim lastRow as Long

lastRow = wsImportData.Range("A5001").End(xlUp).Row

wsImportData.Range("A1:P" & lastRow).Copy



However, if your data starting in A1 is contiguous to the bottom and right of the table, .CurrentRegion will be good enough.


Good luck!

It does work but it copies all the data that has a blank row only formula (=IF(OR(ISBLANK('Laser Data'!A109),'Laser Data'!A109="",ISBLANK('Laser Data'!C109),'Laser Data'!C109="",ISBLANK('Laser Data'!E109),'Laser Data'!E109="",ISBLANK('Laser Data'!F109),'Laser Data'!F109="")=TRUE,"",IF(OR(ISBLANK('Order Information'!$A$2),'Order Information'!$A$2="")=TRUE,"",'Order Information'!$A$2))) on it?