从一张纸复制一列中的每三个单元格，然后粘贴到另一张纸上

Question

I've seen posts regarding copying a range of data and pasting with added blanks, but I need something a bit more complicated.

I have a range of data which I need to copy from one sheet and paste into another. The other sheet has data every 4th cell that I don't want to overwrite. So I basically have a long range of data and I need copy three cells and paste to another sheet under this 4th cell I described, over and over again until I get to the end of the range of data.

Example: This data from sheet 1 Sheet 1 data

Needs to be pasted onto this sheet 2 sheet 2 test

So the final result has sheet 2 where the "test" cells haven't been overwritten sheet 2 with data pasted

Thanks!

edit

Here is the code I'm using now:

'Now, copy specimen results from wb1:

wb1.Sheets(1).Range("D53", wb1.Sheets(1).Range("D53" & NumOfwells * 4 + 44)).Copy

'Now, paste to y worksheet:
wb2.Sheets("Worksheet").Range("J6").PasteSpecial

As you can see, it's a dynamic range being copied that could be more or less depending on an input number (NumOfwells), hence the calculation for the range.

And you can see where in the sheet the copying being done, ie D53 and down on from sheet one on wb1. Then pasted onto the second workbook starting at J6.

Answer 1

Welcome to StackOverflow. If you post questions in the future please include the code that you've tried, and identify where it is failing.

From your question & samples you really don't need to find every 4th row you are really just trying to paste data in places there isn't anything in the target area.

The code uses the same basic loop to do either to show both cases. The following procedure lets you choose your range, and target sheet.

Sub test2()
    Call CopyData(Sheet1.Range("A3:A13"), sheet2)
End Sub

Private Sub CopyData(ByVal SourceRange As Range, ByRef TargetWorksheet As Worksheet)
    Dim oIndex As Long

    For oIndex = 1 To SourceRange.Rows.Count + 1
        ' Check for blanks
        'If TargetWorksheet.Cells(SourceRange.Row + oIndex - 1, 1) = "" Then
        '    TargetWorksheet.Cells(SourceRange.Row + oIndex - 1, 1).Value = SourceRange.Cells(oIndex, 1).Value
        'End If

        ' Skip every 4th row
        If (oIndex - 1) Mod 4 <> 0 Then
            TargetWorksheet.Cells(SourceRange.Row + oIndex - 1, 1).Value = SourceRange.Cells(oIndex, 1).Value
        End If

    Next
End Sub