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?
 
Subodh Tiwari (Neeraj)Connect With a Mentor 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
 
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
Cloud Class® Course: Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

 
Avinash SinghAuthor Commented:
Yes the order will be same
0
 
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
 
LET (Learn Excel in Tamil)Reporting 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
 
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
All Courses

From novice to tech pro — start learning today.