Excel VBA copy range of data and paste in every nth row of another sheet

[paneliyadhruv]

Dear All,

I have two sheets in excel file. First sheet1 having data from column A to J.
I want to paste it in sheet2
From A3 to J3 first row of sheet1.
From A6 to J6 second row of sheet1.
From A9 to J9 second row of sheet1.
And so on till it reach to blank in sheet1.

My data is changing. For example sheet1 may be column A to K or any thing else. Pasting in every nth row i.e. every 4 row or every 3 row depending upon requirement.

Kindly provide your valuable inputs

 

[JackDanIce]

This assumes you will always have data in A3, the nth row or gap is calculated from this column (i.e. click A3, press CTRL+Down and calculate the gap between the activecell and A3) and the width is calculated from this row (3):

Sub MoveData()

    Dim arr()   As Variant
    Dim LR      As Long
    Dim x       As Long
    Dim xStep   As Long
    
    Application.ScreenUpdating = False
    
    With Sheets("Sheet1")
        LR = .Cells(.Rows.Count, 1).End(xlUp).Row
        LC = .Cells(3, .Columns.Count).End(xlToLeft).Column
        xStep = .Cells(3, 1).End(xlDown).Row - 3
        
        For x = 3 To LR Step xStep
            arr = .Cells(x, 1).Resize(, LC).Value
            Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, LC).Value = arr
        Next x
    End With
    
    Application.ScreenUpdating = True
    
    Erase arr

End Sub

 

[paneliyadhruv]

Dear Sir,
From copy sheet1 each row (continuously till blank) and paste it in every nth row of another sheet.

Reverse order of your macro.

 

[JackDanIce]

Change xStep value to suit:

Sub MoveData()

    Dim arr()   As Variant
    Dim LR      As Long
    Dim x       As Long
    Dim xStep   As Long
    
    xStep = 2
    
    Application.ScreenUpdating = False
    
    With Sheets("Sheet1")
        LR = .Cells(.Rows.Count, 1).End(xlUp).Row
        LC = .Cells(3, .Columns.Count).End(xlToLeft).Column
        
        For x = 3 To LR
            arr = .Cells(x, 1).Resize(, LC).Value
            Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(xStep).Resize(, LC).Value = arr
        Next x
    End With
    
    Application.ScreenUpdating = True
    
    Erase arr

End Sub

 

[paneliyadhruv]

Dear Sir,

Working perfectly. However if i want to specify copy column for eg. A to D only and change nth row (may be every 4th or evry 5th row). where i need to make change in macro.

 

[JackDanIce]

Change

LC = .Cells(3, .Columns.Count).End(xlToLeft).Column

To

LC = 4

if you want A to D
LC (last column) represents the column number for the last column the data is in for a specific row (3)

 

[paneliyadhruv]

From specific columns like D to F or G to L. Range of copy column.

 

[JackDanIce]

Adjust this line:

arr = .Cells(x, 1).Resize(, LC).Value

LC explained as above
1 is column "A" so that line is write values from Sheet1 Ax:Dx (if LC = 4) into array and then print contents to Sheet2, first empty row after last used row.

 

[paneliyadhruv]

Thank you very much sir. I will check and let you know.

 

[paneliyadhruv]

Dear Sir,

Working perfectly. Thank you very much for you effort and time.