Conditionally copy paste the data between sheets

Sachin Singh
Sachin Singh used Ask the Experts™
on
Conditionally copy paste the data between sheets
plz see the sample file
sample.xlsb
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015
Commented:
Please give this a try...

Sub CopyDataFromSheet5()
Dim ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet
Dim cnt As Long, i As Long
Dim lr As Long, dlr As Long
Application.ScreenUpdating = False
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")
Set ws4 = Sheets("Sheet4")
Set ws5 = Sheets("Sheet5")
lr = ws5.Cells(Rows.Count, 1).End(xlUp).Row
ws4.Cells.Clear
cnt = ws2.Range("A1").CurrentRegion.Rows.Count - 1
For i = 1 To cnt
    If ws4.Range("A1").Value = "" Then
        dlr = 1
    Else
        dlr = ws4.Range("A" & Rows.Count).End(3)(2).Row
    End If
    ws5.Range("A1:T" & lr).Copy ws4.Range("A" & dlr)
    
Next i

cnt = ws3.Range("A1").CurrentRegion.Rows.Count - 1
For i = 1 To cnt
    If ws4.Range("A1").Value = "" Then
        dlr = 1
    Else
        dlr = ws4.Range("A" & Rows.Count).End(3)(2).Row
    End If
    ws5.Range("A1:T" & lr).Copy ws4.Range("A" & dlr)
Next i

ws4.UsedRange.Sort key1:=ws4.Range("J1"), order1:=xlAscending, Header:=xlNo
Application.ScreenUpdating = True
End Sub

Open in new window

Click the button called "Copy Data" on Sheet4 to run the code.
sample.xlsb

Author

Commented:
Thnx Neeraj Sir for ur great support
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
You're welcome Sachin!
You really did not need to loop. This one liner could have done the same job.

Sub copymultiple()
Sheet5.Range("A1").CurrentRegion.EntireRow.Copy Sheet4.Range("A1").Resize( _
    (Sheet2.Range("A1").CurrentRegion.Rows.Count - 1 + _
    Sheet3.Range("A1").CurrentRegion.Rows.Count - 1) * _
    Sheet5.Range("A1").CurrentRegion.Rows.Count)

End Sub

Open in new window

Author

Commented:
Thnx Saqib Sir for the great info and thnx for the support

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial