conditionally copy and paste the data by vba

conditionally copy and paste the data by vba
see the sample file
highlighted colour is only for understanding purpose
Book1--3-.xlsm
Avinash SinghAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Fabrice LambertFabrice LambertCommented:
Hi,

As it stand, I don't see any "conditional copy".
Can you explain more ?
0
Bill PrewCommented:
In column A of the source sheet, will the same set of rows always be present for every "group" of data?  Will they always be in the same order?  Or could some be in one group, but not another?

abc
def
ghi
jkl
mno


»bp
0
Avinash SinghAuthor Commented:
Yes the order will be same
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Avinash SinghAuthor Commented:
Kindly see the sample file fabrice sir and see the result u will understand what i mean to say i am new to vba so i don't know the exact word that's y i mentioned conditional copy paste
0
LearnReporting Automation ExpertCommented:
Hi Expert,

This code will run once, please add or modify with some coding to do while untill "abc" founded

Sub Test()
Dim Tempvalue As String
Worksheets("Sheet1").Select
ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Temp"
For Each Cell In Worksheets("Sheet1").Range("A2:A6")
Tempvalue = Cell.Value
Worksheets("Temp").Select
Cells.Select
Selection.Find(What:=Tempvalue).Offset(0, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Worksheets("Result").Select
Cells.Select
Selection.Find(What:=Tempvalue).Select
If ActiveCell.Offset(0, 1) <> "" Then
ActiveCell.End(xlToRight).Offset(0, 1).Select
ActiveCell.PasteSpecial
Else
ActiveCell.Offset(0, 1).PasteSpecial
End If
Worksheets("Temp").Select
ActiveCell.EntireRow.Delete
Next
End Sub

Open in new window

0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You may try something like this...

Sub CopyData()
Dim sws As Worksheet, dws As Worksheet
Dim lr As Long, lc As Long, dlc As Long, i As Long, j As Long, cnt As Long, r As Long
Dim Rng As Range, copyRng As Range
Application.ScreenUpdating = False

Set sws = Sheets("Sheet1")
Set dws = Sheets("Sheet2")
lr = sws.Cells(Rows.Count, 1).End(xlUp).Row
cnt = Range("A1").End(xlDown).Row
dws.Cells.Clear
sws.Range("A2", sws.Range("A1").End(xlDown)).Copy dws.Range("A1")
For j = 2 To cnt + 1
    For i = 1 To sws.Range("A1:A" & lr).SpecialCells(xlCellTypeConstants, 2).Areas.Count
        dlc = dws.Cells(j - 1, Columns.Count).End(xlToLeft).Column + 1
        Set Rng = sws.Range("A1:A" & lr).SpecialCells(xlCellTypeConstants, 2).Areas(i)
        r = Rng.Cells(j).Row
        lc = sws.Cells(r, Columns.Count).End(xlToLeft).Column
        Set copyRng = sws.Range(sws.Cells(r, 2), sws.Cells(r, lc))
        copyRng.Copy dws.Cells(j - 1, dlc)
    Next i
    Set copyRng = Nothing
Next j
Application.ScreenUpdating = True
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Fabrice LambertFabrice LambertCommented:
I looked at your file thanks.

What I see is more or less copy and happen cells to each others than conditional copy (else, I missed the condition).

Well, a possible solution can be Something like the following:
Option Explicit

Public Sub test()
    Dim wb As Excel.Workbook
    Set wb = ThisWorkbook
    
    Dim src As Excel.Worksheet
    Set src = wb.Worksheets(1)
    
    Dim trg As Excel.Worksheet
    Set trg = wb.Worksheets(2)
    
    happenRange trg.Range("A1"), src.Range("A2:G2"), src.Range("A9:F9"), src.Range("A16:H16"), src.Range("A23:H23")
End Sub

Private Sub happenRange(ByRef trg As Excel.Range, ParamArray srcs() As Variant)
    Dim src As Excel.Range
    Set src = srcs(LBound(srcs))
    
        '// Copy the 1st cell
    trg.Value = src.Cells(1).Value
    Set trg = trg.Offset(columnoffset:=1)
    
    Dim i As Integer
    For i = LBound(srcs) To UBound(srcs)
        Set src = srcs(i)
        
            '// copy all cells, skipping the 1st of each range
        Dim skip As Boolean
        skip = True
        For Each cell In src.Cells
            If Not skip Then
                trg.Value = cell.Value
                Set trg = trg.Offset(columnoffset:=1)
            End If
            skip = False
        Next
    Next
End Sub

Open in new window

Note: The code only work for the 1st row, you should duplicate and adapt the line #13 to fit your needs.
0
Avinash SinghAuthor Commented:
Thnx to all members for giving ur precious time to this post & Thnx Neeraj sir
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Avinash!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.