copy and paste based on certain conditions-CodePudding

i need a simple vba code. I hope someone can help me. So, I want to copy the range B2:E6 and leave some cells marked with a special condition. I created a rule in cells A2:A6 with the value Y / X. In the end, I want to paste the value B2:E6 in the range F9:I13 only if the value is Y.

I am attaching the following image to make it easier for you to understand.

Any help will be great. And sorry my english is bad.

CodePudding user response：

I recommend that you first define your working worksheet, if the CommandButton1 button code linked to the CommandButton1_Click() event, showen in your code, is not associated with your working sheet (Sheet9). Otherwise, the code will be executed on another Sheet than Sheet9, on which you want the conditions to be fulfilled.

So, I suggest this code, that formats also the target table "(F8:I13)":

Private Sub CommandButton1_Click()
 Dim myWorkingSheet As Worksheet
 Dim Working_Range As Range, Target_Range As Range
 Dim Line_to_Read As Double, Table_Shift As Double

 Set myWorkingSheet = Sheets("Sheet9")
 myWorkingSheet.Activate
'    Copy the header table
 myWorkingSheet.Range("B1:E1").Copy Range("F8")
 Application.CutCopyMode = False
'    Copy the format of the table
 myWorkingSheet.Range("B1:E6").Copy
 myWorkingSheet.Range("F8").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
 Application.CutCopyMode = False

'  Copy table if current cell in column A = "y"
 Set Working_Range = myWorkingSheet.Range("A2:A6")
 Line_to_Read = 2
 Table_Shift = 7 'To start at F9 cell
 For Each wr In Working_Range
    If wr = "y" Then
        myWorkingSheet.Range(Cells(Line_to_Read, 2), Cells(Line_to_Read, 5)).Copy myWorkingSheet.Range(Cells(Line_to_Read   Table_Shift, 6), Cells(Line_to_Read   Table_Shift, 10))
    End If
    Line_to_Read = Line_to_Read   1
 Next
 ' To point the cursor at the first cell.
 myWorkingSheet.Cells(1, 1).Select
End Sub

To avoid the repetition of myWorkingSheet in the you use With clause and End With.

CodePudding user response：

Maybe this can get you started

Sub Macro1()
Dest = 8
For Row = 1 To 6
    If Cells(Row, 1) <> "x" Then
        Range(Cells(Row, 2), Cells(Row, 5)).Select
        Selection.Copy
        Cells(Dest, 6).Select
        ActiveSheet.Paste
    End If
    Dest = Dest   1
Next Row
End Sub