Copy and paste dynamic range

**wpryan** · 04-15-2010, 09:35 AM

Hi All, I'm working with the following code:

Sub Export()
Dim fName As String, fPath As String
Dim PartsLR As Long
PartsLR = Sheets("ReportSummary").Range("AY" & Rows.Count).End(xlUp).Row
Dim FaultLR As Long
FaultLR = Sheets("ReportSummary").Range("AN" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False


With Sheets("ReportSummary")
    .Unprotect Password:="ServiceODOS"
    .Visible = True
    fPath = ActiveWorkbook.Path & "\"
    fName = .Range("S2") & "_" & "ReportSummary"
    .Copy
        Cells.Value = Cells.Value
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "CustomerData"
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "SystemData"
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "ServiceData"
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "FailureData"
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "PartsData"
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "LaserPowerData"
        Sheets.Add After:=Sheets(Sheets.Count)
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "CameraLightData"
        Sheets("ReportSummary").Select
        Columns("A:K").Select
        Selection.Copy
        Sheets("CustomerData").Select
        ActiveSheet.Paste
        Sheets("ReportSummary").Select
        Columns("L:R").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("SystemData").Select
        ActiveSheet.Paste
        Sheets("ReportSummary").Select
        Columns("S:AK").Select
        Selection.Copy
        Sheets("ServiceData").Select
        ActiveSheet.Paste
        Sheets("ReportSummary").Select
        Range("AL1:AW" & FaultLR).Copy
        Sheets("FailureData").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
        Sheets("ReportSummary").Select
        Range("AX1:BD" & PartsLR).Copy
        Sheets("PartsData").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
        Sheets("ReportSummary").Select
        Columns("BE:BL").Select
        Selection.Copy
        Sheets("LaserPowerData").Select
        ActiveSheet.Paste
        Sheets("ReportSummary").Select
        Columns("BM:BS").Select
        Selection.Copy
        Sheets("CameraLightData").Select
        ActiveSheet.Paste
        Sheets("ReportSummary").Activate
        Range("A4").Select
        
        Sheets("ReportSummary").Activate
            Cells.Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
            
        ActiveWorkbook.SaveAs Filename:=fPath & fName & ".xls", FileFormat:=xlNormal
        ActiveWindow.Close
    .Visible = False
    .Protect Password:="ServiceODOS"
End With

Sheets("Report").Activate
Application.ScreenUpdating = True
End Sub

The purpose of it is to copy a worksheet of one workbook and paste to another workbook, and then sub-divide the data into individual worksheets, and lastly renaming the new file and closing it. There are two dynamic ranges in the original file where the code attempts to find the last row of the data and copy the 'legitimate' data. The data ranges, called in the code PartsLR and FaultLR, have a maximum data range of 21 rows 31 rows, respectively. The purpose of the export is for me to in turn import the data into an Access database. With this code, somehow the range for PartLR is working OK but the FaultLR is considered as having data, so all 31 rows are being imported, even though most of them don't have data. I can't find where this is breaking down. Can anyone help? Thanks in advance.

**mdbct** · 04-15-2010, 10:37 AM

I'm guessing the AN column has formulas in it that can result in a blank. A formula such as:
=if A1<2,"small number,"")

Using the End(xlUp) method will find the last cell with a formula/entry. You can use the find method to find the last non blank cell.

FaultLR= Sheets("ReportSummary").Range("AN:AN").Find(what:="*", LookIn:=xlValues, _
             SearchDirection:=xlPrevious).Row

**wpryan** · 04-15-2010, 02:12 PM

Thanks for your response. You're exactly right, there are underlying formulas that are in these cells. I changed the code as you suggested by replacing the line 'FaultLR = Sheets("ReportSummary").Range("AN" & Rows.Count).End(xlUp).Row' with the line you provided but am getting an error "Run-time error '448': Named argument not found. Any ideas?

**mdbct** · 04-15-2010, 02:45 PM

I fat fingered the D in SearchDirection and made it SearchSirection when I was cleaning up the capitalization. I've updated my post to the correct spelling.

**wpryan** · 04-15-2010, 02:57 PM

That did the trick. Thanks much for your help!

**wpryan** · 04-16-2010, 08:28 AM

Sorry to bother again, however I just noticed another feature I didn't see before. The beginning part of the code

With Sheets("ReportSummary")
    .Unprotect Password:="ServiceODOS"
    .Visible = True
    fPath = ActiveWorkbook.Path & "\"
    fName = .Range("S2") & "_" & "ReportSummary"
    .Copy
        Cells.Value = Cells.Value

will copy the values from the first workbook to the second. This bit suffers from the same problem which caused me to start the thread... It is not getting the values only, it is getting the underlying formula as well and causing extra empty rows to be generated. I can't figure out how to get only the cells with legitimate data. Sorry again, I'm in the learning stage with VBA... For the rest it's working great.

**mdbct** · 04-16-2010, 09:01 AM

Do the same thing for the PartsLR as you did with the FaultLR

PartsLR = Sheets("ReportSummary").Range("AY" & Rows.Count).End(xlUp).Row

The bit of code you posted will change the formulas to their values with this line

 Cells.Value = Cells.Value

Blank formula results would result in blank cells. The problem is that you determine the last row before you convert the formulas to their values.

I would suggest using a different method for converting the formulas to their values- It will speed up the macro's execution time. Currently you are affecting the entire sheet with the "Cells.Value = Cells.Value" line. Use this instead:

Range(Cells(1, 1), Cells.SpecialCells(xlCellTypeLastCell)).Value = _
Range(Cells(1, 1), Cells.SpecialCells(xlCellTypeLastCell)).Value

If you've already run the original macro on the sheet without saving and closing the book, my suggestion will be run against the entire sheet since the LastCell is the lower right corner of the spreadsheet due to if being acted upon by the " Cells.Value = Cells.Value"

**wpryan** · 04-16-2010, 09:42 AM

Thanks for your quick reply. Let me summarize again what I'm trying to do (and my apologies if I'm becoming bothersome)...

The code should 1/ take one worksheet from one workbook, copy the 'legitimate' values (no underlying formulas, which it seems to be doing), and paste into a new workbook. From there code should 2/ create eight new worksheets and 3/ sub-divide the data (copy and paste) from the imported worksheet into various worksheets. Parts 2 and 3 are doing exactly what I want - copying and pasting only the values. However, Part 1 is somehow still considering the underlying formulas to be data. I think I need to dim the data range in a similar way to the PartsLR and FaultLR, but I don't know how that can be done.
By the way the other code you supplied to speed up the execution is working great!