Copy two specific range (tab1 and tab2) and non-contiguous cells to another sheet

[marreco]

Hi
I need copy datas from sheet CreazyRange to sheet "Sumary"

I show manual results in sheet "Sumary"

Thank you!!

 

[Luke M]

This should do it for you.

Sub CopyData()
Dim lastRow As Long
Dim startRow As Long
Const dataStart As Long = 4 'Row with header in CreazyRange
Dim ws As Worksheet

Application.ScreenUpdating = False
Set ws = Worksheets("CreazyRange")

With Worksheets("Sumary")
    'Delete this next line if you don't want to start clean
    .Range("2:" & .Rows.Count).ClearContents
   
    'Copy first table
    startRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
   
    lastRow = ws.Cells(.Rows.Count, "A").End(xlUp).Row
    ws.Cells(dataStart + 1, "A").Resize(lastRow - dataStart, 5).Copy .Cells(startRow, 1)
    .Cells(startRow, "F").Resize(lastRow - dataStart).Value = ws.Range("A2").Value
    .Cells(startRow, "G").Resize(lastRow - dataStart).Value = ws.Range("B1").Value
    .Cells(startRow, "H").Resize(lastRow - dataStart).Value = ws.Range("E21").Value
   
    'Copy second table
    startRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
   
    lastRow = ws.Cells(.Rows.Count, "G").End(xlUp).Row
    ws.Cells(dataStart + 1, "G").Resize(lastRow - dataStart, 5).Copy .Cells(startRow, 1)
    .Cells(startRow, "F").Resize(lastRow - dataStart).Value = ws.Range("G2").Value
    .Cells(startRow, "G").Resize(lastRow - dataStart).Value = ws.Range("H1").Value
    .Cells(startRow, "H").Resize(lastRow - dataStart).Value = ws.Range("K21").Value
   
End With
Application.ScreenUpdating = True
End Sub

 

[marreco]

It's magic solution!!

Thank very very much!!!!!!!!!!!!!!!!!!!!!!