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
'

'
Sheets("Temp").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("Import Data").Select
Cells.Select
Selection.Copy
Sheets("Temp").Select
Range("A1").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
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Sheets("Order Information").Select
Range("A2").Select
Sheets("Temp").Select
Range("A1").Select
Application.Run "'Laser Marking Traveler.xlsm'!Range_End_Method"
Sheets("Order Information").Select
Range("A2").Select
ActiveWorkbook.Save
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
rows(lRow).Delete
End Sub

@FJMSalgueiro 

 

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
        .Cells.Clear
        .Activate
        
        'get the data to be copied
        'must be done after .Cells.Clear as this deactivates the copy
        wsImportData.Range("A1").CurrentRegion.Copy
        
        .Range("A1").PasteSpecial xlPasteValues
        Set rng = .Range("A1").CurrentRegion
    End With

    
    'remove dupes, autofit and delete last row
    rng.RemoveDuplicates Header:=xlYes
    rng.EntireColumn.AutoFit
    rng.Rows(rng.Rows.Count).Delete

    'save the workbook
    wb.Save
    
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:

 

 

wsImportData.Range("A1").CurrentRegion.Copy

 

 

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?