In Excel VBA - Copy one DataSet of 8 rows and Paste is same excel N number or times.

[prashant230182]

In Excel VBA - Copy one DataSet of 8 rows and Paste is same excel N number or times. I have data set of 8 rows and 5 Columns
Requirement
Copy data set of 8 rows once and paste N number of times with respect to project requirement.
I am using below code and able to paste is once, but not able to past same data set N number of times based on my requirement

ActiveSheet.UsedRange.Offset(1, 0).Copy
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste

I tired Looping too
For Row = 1 To 2
ActiveSheet.UsedRange.Offset(1, 0).Copy
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
Next Row

but not working with above logic data set paste 3 times but still with N number times its failing

main	cl1	cl2	cl3	cl4
1	a1	H1	J1	M1
2	a2	H2	J2	M2
3	a3	H3	J3	M3
4	a4	H4	J4	M4
5	a5	H5	J5	M5
6	a6	H6	J6	M6

I want below data set to be paste N number of time in loop based on my req*

1	a1	H1	J1	M1
2	a2	H2	J2	M2
3	a3	H3	J3	M3
4	a4	H4	J4	M4
5	a5	H5	J5	M5
6	a6	H6	J6	M6

 

[Trebor76]

Hi prashant230182,

Welcome to MrExcel!!

Try this:

Option Explicit
Sub Macro1()

    Dim lngLastRow As Long, lngPasteRow As Long, lngCounter As Long
    Dim wsSrc As Worksheet
    Dim strSrcCols As String
  
    Application.ScreenUpdating = False
  
    Set wsSrc = ThisWorkbook.Sheets("Sheet1") '<-Sheet name containing the data. Change to suit.
    strSrcCols = "A:E" '<-Columns containing the data. Change to suit.
  
    lngLastRow = wsSrc.Range(strSrcCols).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  
    For lngCounter = 1 To 8
        lngPasteRow = wsSrc.Range(strSrcCols).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
        wsSrc.Range(Split(strSrcCols, ":")(0) & "2:" & Split(strSrcCols, ":")(1) & lngLastRow).Copy Destination:=wsSrc.Range(Split(strSrcCols, ":")(0) & lngPasteRow)
    Next lngCounter
  
    Application.ScreenUpdating = True
  
End Sub

Regards,

Robert

 

[prashant230182]

Hi prashant230182,

Welcome to MrExcel!!

Try this:

Option Explicit
Sub Macro1()

    Dim lngLastRow As Long, lngPasteRow As Long, lngCounter As Long
    Dim wsSrc As Worksheet
    Dim strSrcCols As String
 
    Application.ScreenUpdating = False
 
    Set wsSrc = ThisWorkbook.Sheets("Sheet1") '<-Sheet name containing the data. Change to suit.
    strSrcCols = "A:E" '<-Columns containing the data. Change to suit.
 
    lngLastRow = wsSrc.Range(strSrcCols).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
    For lngCounter = 1 To 8
        lngPasteRow = wsSrc.Range(strSrcCols).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
        wsSrc.Range(Split(strSrcCols, ":")(0) & "2:" & Split(strSrcCols, ":")(1) & lngLastRow).Copy Destination:=wsSrc.Range(Split(strSrcCols, ":")(0) & lngPasteRow)
    Next lngCounter
 
    Application.ScreenUpdating = True
 
End Sub

Regards,

Robert

Really Appreciated on quick turnaround on provide simple and quick to understand logic.

I was able to complete my task and it worked for all conditions.
Only thing, I did strSrcCols = "A:E" '<-Columns containing the data. Change to suit. <----- I provide Hardcode value on number of columns
can i provide condition on dynamically selecting the columns, as present Columns number were fixed it worked, I want to understand for Future and make it more dynamics.

But really Thanks I was able to complete the Excel automation task of one day to 1 hrs.

 

[Trebor76]

But really Thanks I was able to complete the Excel automation task of one day to 1 hrs.

WOW - that's great!!

Only thing, I did strSrcCols = "A:E" '<-Columns containing the data. Change to suit. <----- I provide Hardcode value on number of columns
can i provide condition on dynamically selecting the columns, as present Columns number were fixed it worked, I want to understand for Future and make it more dynamics.

Try this where the user selects the columns to be copied:

Option Explicit
Sub Macro1()

    Dim lngLastRow As Long, lngPasteRow As Long, lngCounter As Long
    Dim wsSrc As Worksheet
    Dim strSrcCols As String
    Dim rngSrcCols As Range
    
    On Error Resume Next
        Set rngSrcCols = Application.InputBox(Prompt:="Select the Entire Columns to be Copied:", Type:=8)
    On Error GoTo 0
    If rngSrcCols Is Nothing Then
        Exit Sub
    Else
        strSrcCols = CStr(rngSrcCols.Address)
    End If

    Set wsSrc = ThisWorkbook.Sheets("Sheet5") '<-Sheet name containing the data. Change to suit.
    
    lngLastRow = wsSrc.Range(strSrcCols).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    For lngCounter = 1 To 8
        lngPasteRow = wsSrc.Range(strSrcCols).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
        wsSrc.Range(Split(strSrcCols, ":")(0) & "2:" & Split(strSrcCols, ":")(1) & lngLastRow).Copy Destination:=wsSrc.Range(Split(strSrcCols, ":")(0) & lngPasteRow)
    Next lngCounter
    
    Application.ScreenUpdating = True
    
End Sub

Regards,

Robert