CODEWITHSUNDEEP
vbaexcel
J. Jenkins
J. Jenkins

Reputation: 11

VBA - Copy data within a specified range to a different specified range on another sheet

Need some help creating a excel VBA. I have little to none experience and usually just find VBAs online and adjust.

I'm wanting to copy data from Rows 2 to 14 / columns A:B,D:F (skipping column C) IF cell F is above 0.1 from sheet1 to rows 17 to 30 / columns A:E on sheet 2. (If I can't skip column C I can change my data to cope with this)

I will also have certain formatting in sheet2 that won't be on sheet1 so I need to ensure that the data is only copied as a value.

I tried creating my own before I wanted to skip a column when copying and I got half way.. I just couldn't figure out how to copy starting from a certain row instead of next available...

Private Sub Workbook_Open()
Dim i

For i = 2 To 14
If Sheets("sheet1").Cells(i, "f").Value > 0.1 Then
Sheets("sheet1").Cells(i, "f").EntireRow.Copy Destination:=Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
End Sub

Upvotes: 1

Views: 2084

Answers (4)

user3598756
user3598756

Reputation: 29421

you could exploit AutoFilter() and SpecialCells() methods of Range object, like per the following (commented) code:

With Worksheets("sheet1").Range("A1:F14") '<--| reference your relevant range (including headers in row 1)
    .AutoFilter Field:=6, Criteria1:=">0.1" '<--| filter data on column "F" (the 6th of your referenced range) with values greater than 0.1
    If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then  '<--| if any cell other than header ones has been filtered...
        .Columns(3).Hidden = True ' <--| temporarily hide column "C" (the 3rd of your referenced range) not to be "caught" by subsequent filter on visible cells
        .Offset(1).Resize(.Rows.count - 1).SpecialCells(xlCellTypeVisible).Copy '<--| copy "visible" cells (skipping headers)
        Worksheets("sheet2").Range("A1").PasteSpecial xlPasteValues '<--| paste values
        .Columns(3).Hidden = False '<--| bring column "C" back visible
    End If
End With

where it's assumed that row 1 of worksheet sheet1 is the "header" row

Upvotes: 0

user6432984
user6432984

Reputation:

Rows returns a range object of all the cells in the row. Rows().Range() returns a range relative to the Row. Know this allows use to write some very clean and condensed code.

enter image description here

Copy Data and Formatting

Private Sub Workbook_Open()
    Dim i As Long
    Dim Target As Range
    Set Target = Sheets("sheet2").Range("A17")

    With Sheets("sheet1")
        For i = 2 To 14
            If .Cells(i, "f").Value > 0.1 Then
                .Rows(i).Range("A1:B1,D1:F1").Copy Destination:=Target.Offset(i - 2)
            End If
        Next i
    End With
End Sub

Copy Data only

Private Sub Workbook_Open1()

    Dim i As Long
    Dim Target As Range
    Set Target = Sheets("sheet2").Range("A17")

    With Sheets("sheet1")
        For i = 2 To 14
            If .Cells(i, "f").Value > 0.1 Then
                .Rows(i).Range("A1:B1,D1:F1").Copy
                Target.Offset(i - 2).PasteSpecial xlPasteValues
            End If
        Next i
    End With
    Application.CutCopyMode = False
End Sub

Upvotes: 0

Shai Rado
Shai Rado

Reputation: 33672

Not sure why want this code in the Workbook_Open event, but since you only want to paste the values (and not the format), you need to split the Copy >> Paste command into 2 lines.

The code below will paste only the values, without leaving blanks in Column C in "sheet2" :

Private Sub Workbook_Open()

Dim i As Long

With Sheets("sheet1")
    For i = 2 To 14
        If .Cells(i, "F").Value > 0.1 Then
            .Range("A" & i & ":B" & i & "," & "D" & i & ":F" & i).Copy
            Sheets("sheet2").Range("A" & i + 15).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False

        End If
    Next i
End With

End Sub

Edit 1: If you don't want to have blank rows in "Sheet2" (in cases Cell F <= 0.1) then use the code below, it will paste the values in consecutive rows, starting from row 15 :

Dim i As Long
Dim j As Long

' start row number in Sheet2 (for pasted rows)
j = 15
With Sheets("sheet1")
    For i = 2 To 14
        If .Cells(i, "F").Value > 0.1 Then
            .Range("A" & i & ":B" & i & "," & "D" & i & ":F" & i).Copy
            Sheets("sheet2").Range("A" & j).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False

            j = j + 1
        End If
    Next i
End With

Upvotes: 1

TyloBedo
TyloBedo

Reputation: 495

I think this is what you're asking for. It will paste the cells into i + 15 (so cell 2 pastes into 17, cell 14 into 29). I also split it into two separate copy functions so that you can skip over column c.

Private Sub Workbook_Open()
Dim i

For i = 2 To 14
If Sheets("sheet1").Cells(i, "f").Value > 0.1 Then
 Sheets("sheet1").Range("A" & i & ":B" & i).Copy Destination:=Sheets("sheet2").Range("A" & i + 15)
 Sheets("sheet1").Range("D" & i & ":F" & i).Copy Destination:=Sheets("sheet2").Range("D" & i + 15)
End If
Next i
End Sub

Upvotes: 0

Related Questions