Copy row values after another row values, copy who

2019-08-26 09:49发布

I am a total novice at this. Trying to the following: I have paired data in rows, one below the other, and I want it to be one next to the other (so instead of ranges A2 to FP2 and A3 to FP3, I want it to be A2 to MF2). So, basically, I need to append every other row to the previous row.

I've been trying to make a loop to copy it and then cut that row to another sheet, so that the condition stays the same (always copy row 3 next to row 2), but then I can't make it copy into new free row of second sheet. I have encountered various problems during debugging (Fors, Ifs, Columns...)

Anyway, here is the current code, although awful, and thanks a lot in advance!

Sub pairs()

Application.CutCopyMode = False
For Each cell In Sheets("Sve").Range("A2")
        Sheets("Sve").Select
        Range("A3:FQ3").Select
        Selection.Cut
        Range("FR2").Select
        ActiveSheet.Paste
        Rows("3:3").Select
        Selection.Delete Shift:=xlUp
        Rows("2:2").Select
        Selection.Cut
        Sheets("Gotovo").Select
        sourceCol = 1
        rowCount = Cells(Rows.Count, sourceCol).End(x1Up).Row
        For currentRow = 1 To rowCount
        currentRowValue = Cells(currentRow, sourceCol).Value
            If IsEmpty(currentRowValue) Or currentRowValue = "" Then
                Cells(currentRow, sourceCol).Select
            End If
        Next
        ActiveSheet.Paste
        Sheets("Sve").Select
Next

End Sub

1条回答
Bombasti
2楼-- · 2019-08-26 10:42

I've found that it's easier to delete rows as you're looping through data if you start from the bottom and work your way up.

Dim myRange As Range
Dim rowCount As Integer

' Get the range of cells and the count of cells in the A Column
Set myRange = Range("A1", Range("A1").End(xlDown))
rowCount = myRange.Cells.Count

' Start loop at the last row and decrease by 2
For i = rowCount To 2 Step -2

    ' Get the data in the i-th row, inclusive of blank cells between data
    Set secondrow = Range(myRange.Cells(i, 1), Cells(i, Columns.Count).End(xlToLeft))

    ' place i-th row at the end of the (i-1)th row, inclusive of any 
    ' blank cells b/t data
    secondrow.Copy Cells(i - 1, Columns.Count).End(xlToLeft).Offset(0, 1)

    ' Delete the second row
    myRange.Cells(i, 1).EntireRow.Delete
Next i

Now that you have a sheet with the rows formatted the way you want, you can update your code to copy all of this data over to your other sheet.

UPDATED

this code includes a method for capturing rows with blank data. Since a row of data may have blank cells (e.g. A B (blank) D), I use Columns.Count to get the very last column of the row, and then use the .End(XlToLeft) method to get the last non blank cell of the row. When pasting the data, you simply have to increase the column number by one (i.e. Offset(0,1)) in order to not copy over the last cell of data in the row.

查看更多
登录 后发表回答