Copy Multiple Ranges regardless of blank cells to another Worksheet

[Webbers]

Hi all!

I am having issues doing a copy/paste from one worksheet within a workbook to another. My raw data (or data dump) file has 55 columns, this is constant (A-BC). The number of rows will vary each time it is run. It can vary from 3,500 to 35,000. This is something for someone else, so I must have the macro copy multiple ranges of the data into the "working" sheet. The working sheet contains formulas also. There are formulas between many of these ranges so I don't have the ability to do a simple copy/paste of all 55 columns. And I just got a fresh copy of this raw data, and it has some blank rows within some of the actual data.

Since I have blank rows scattered through the data, I know I cannot use Range(Selection, Selection.End(xlDown)).Select (I was), and as a result, an abundance of missing data. I know I need to use an xlup code, but I am not sure how to "convert" my code. I am using sheet codenames, as I have no clue if the user will change the names to the worksheets. My previous code is below... and worked perfectly, until this new data dump containing partial blank rows (A-AE populated, then AF - AS blank cells, then AT - BB populated, and BC blank). This is one specific example. This worksheet has 3,594 rows of data. A "required" item for each row resides in column C, if that helps at all. So if a row (regardless of the range) contains data in cell C of that row it must be copied. Thanks in advance.

Sub CopyRangeToAnotherSheet()
       
'  Copies data from "data (Sheet1) to Sheet3 (Sheet3)
'  Data is pasted as values
       
' Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
       
With Sheet3
    With .Cells(1, 1).CurrentRegion
        With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
            .Cells.Interior.Pattern = xlNone
        End With
    End With
End With
       
' Range 1
    ' Copy the data
        Sheet1.Select
        Range("A4:H4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
    ' Destination worksheet
        Sheet3.Range("A2").PasteSpecial Paste:=xlPasteValues
    ' Clear Clipboard (removes "marching ants" around your original data set)
        Application.CutCopyMode = False
       
' Range 2
    ' Copy the data
        Sheet1.Select
        Range("J4:AB4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
    ' Destination worksheet
        Sheet3.Range("J2").PasteSpecial Paste:=xlPasteValues
    ' Clear Clipboard (removes "marching ants" around your original data set)
        Application.CutCopyMode = False

' Range 3
    ' Copy the data
        Sheet1.Select
        Range("AC4:AH4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
    ' Destination worksheet
        Sheet3.Range("AD2").PasteSpecial Paste:=xlPasteValues
    ' Clear Clipboard (removes "marching ants" around your original data set)
        Application.CutCopyMode = False
       
' Range 4
    ' Copy the data
        Sheet1.Select
        Range("AI4:AI4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
    ' Destination worksheet
        Sheet3.Range("AK2").PasteSpecial Paste:=xlPasteValues
    ' Clear Clipboard (removes "marching ants" around your original data set)
        Application.CutCopyMode = False

' Range 5
    ' Copy the data
        Sheet1.Select
        Range("AJ4:AP4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
    ' Destination worksheet
        Sheet3.Range("AM2").PasteSpecial Paste:=xlPasteValues
    ' Clear Clipboard (removes "marching ants" around your original data set)
        Application.CutCopyMode = False
       
' Range 6
    ' Copy the data
        Sheet1.Select
        Range("AQ4:BC4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
    ' Destination worksheet
        Sheet3.Range("AU2").PasteSpecial Paste:=xlPasteValues
    ' Clear Clipboard (removes "marching ants" around your original data set)
        Application.CutCopyMode = False
        Range("A1").Select

' activates sheet of specific name
' Activates the "Main" tab (Sheet2)
    Sheet2.Activate

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

 

[DanteAmor]

Try this

Sub CopyRangeToAnotherSheet()
       
'  Copies data from "data (Sheet1) to Sheet3 (Sheet3)
'  Data is pasted as values
       
' Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
       
    With Sheet3
        With .Cells(1, 1).CurrentRegion
            With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                .Cells.Interior.Pattern = xlNone
            End With
        End With
    End With
    
    Dim lr As Long
    lr = Sheet1.Range("C" & Rows.Count).End(xlUp).Row
    ' Range 1
        Sheet1.Range("A4:H" & lr).Copy
        Sheet3.Range("A2").PasteSpecial Paste:=xlPasteValues
    ' Range 2
        Sheet1.Range("J4:AB" & lr).Copy
        Sheet3.Range("J2").PasteSpecial Paste:=xlPasteValues
    ' Range 3
        Sheet1.Range("AC4:AH" & lr).Copy
        Sheet3.Range("AD2").PasteSpecial Paste:=xlPasteValues
    ' Range 4
        Sheet1.Range("AI4:AI" & lr).Copy
        Sheet3.Range("AK2").PasteSpecial Paste:=xlPasteValues
    ' Range 5
        Sheet1.Range("AJ4:AP" & lr).Copy
        Sheet3.Range("AM2").PasteSpecial Paste:=xlPasteValues
    ' Range 6
        Sheet1.Range("AQ4:BC" & lr).Copy
        Sheet3.Range("AU2").PasteSpecial Paste:=xlPasteValues


    ' activates sheet of specific name
        Sheet2.Activate


    'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

 

[Webbers]

DanteAmor,

That works perfectly, and so much cleaner looking than my code. I will definitely be hanging on to this code and using it in many of my projects. Thanks so much for the great code and the fast response. Your time and your VBA code are greatly appreciated!

 

[DanteAmor]

I'm glad to help you. I appreciate your kind comments.