Using VBA copy data from one cell to another on another page

[rplohocky]

After spending over an hour trying to find another post that could solve my problem I am creating a new post.

I am looking for the complete code that will copy data from cell A1, A2, A3, A4 and A5 only if cell A6 in NOT BLANK and then place that date into a different sheet by looking for the next available row.

I have been using this to copy and paste but its not complete.

Sub process_mailings()
Dim Route1 as Variant
Dim Route2 as Variant
Dim Route3 as Variant
Dim Route4 as Variant
Dim Route5 as Variant
Dim Route6 as Variant
Route1 = Range("A1")
Route2 = Range("B1")
Route3 = Range("C1")
Route4 = Range("D1")
Route5 = Range("E1")
Route6 = Range("F1")

Sheets("Mailings").Select
Range("A1").Activate

For Counter = 1 To 200
If "" = ActiveCell.Value Then
ActiveCell.Value = Route1
Cell = "A" & ActiveCell.Row
Range(Cell).Offset(0, 1).Value = Route2
Range(Cell).Offset(0, 2).Value = Route3
Range(Cell).Offset(0, 2).Value = Route4
Range(Cell).Offset(0, 2).Value = Route5
Range(Cell).Offset(0, 2).Value = Route6
GoTo escape1
Else: Cell = "A" & ActiveCell.Row + 1
Range(Cell).Activate
End If
Next
escape1:

End Sub

 

[michaelsmith559]

If you only need to copy sheet 1 range a1:a5 if a6 is not blank try this code:

Sub Copy_Range()
Dim rng As Range
Set rng = Sheets("Sheet1").Range("A1:A5")

If IsEmpty(Sheets("Sheet1").Range("A6").Value) = True Then
    Exit Sub
Else
If IsEmpty(Sheets("Sheet2").Range("A1048576").End(xlUp).Value) = True Then
Worksheets("Sheet2").Range("A1048576").End(xlUp).Resize(rng.Rows.Count, rng.Columns.Count). _
    Cells.Value = rng.Cells.Value
Else
Worksheets("Sheet2").Range("A1048576").End(xlUp).Offset(1, 0).Resize(rng.Rows.Count, rng.Columns.Count). _
    Cells.Value = rng.Cells.Value
End If
End If

End Sub

 

[rplohocky]

Hello Michael,
Thank you for this code, it works great! However this is not totally what I am looking for. To keep things simple I only gave a basic description of the code I need and thought I could modify it on my own but being a rookie at VBA I am stuck again.

Your code does what its supposed to do but I need it to do the same function on multiple rows. For example, the code you wrote checks A6 to see if its blank or not and either stop or copy A1, A2, A3, A4, A5 and A6 to a new page. I need it to do the same thing to the next 20 ROWS, check B6 to see if its blank and either stop or copy B1, B2, B3, B4, B5 and B6, check C6 to see if its blank and either stop or copy C1, C2, C3, C4, C5 and C6 and so on. Would you be able to modify this code to do maybe 3 rows and I can add the additional functions for the remaining 17 rows?

I really appreciate your help.

 

[rplohocky]

OOOOOPPPPPPPSSSSS!

Above I put A, B, C and kept the numbers the same, I need the letters to stay the same and the numbers to to change being that I need the code to check rows not columns, sorry.

 

[michaelsmith559]

See if this is what you need:

Sub Copy_Range()
Dim rng As Range
Dim i As Integer, j As Integer, c As Long
i = 1
j = 5
With Sheets("Sheet1")
lastColumn = Range("A1").End(xlToRight).Column
    For c = 1 To lastColumn
        Set rng = Sheets("Sheet1").Range(Cells(i, c), Cells(j, c))
            If IsEmpty(Sheets("Sheet1").Range("A6").Value) = True Then
                Exit Sub
            Else
            If IsEmpty(Sheets("Sheet2").Range("A1048576").End(xlUp).Value) = True Then
                Worksheets("Sheet2").Range("A1048576").End(xlUp).Resize(rng.Rows.Count, rng.Columns.Count). _
                Cells.Value = rng.Cells.Value
            Else
                Worksheets("Sheet2").Range("A1048576").End(xlUp).Offset(1, 0).Resize(rng.Rows.Count, rng.Columns.Count). _
                    Cells.Value = rng.Cells.Value
            End If
            End If
    Next c
End With
End Sub

 

[rplohocky]

Maybe I should start over since my last explanation was screwed up.

I need to copy cells A1, B1, C1, D1, E1 and F1 from "Sheet 1" to "Sheet 2" in the next available row starting on row A1, only if cell F1 has data in it. The macro needs to repeat this function on the next 20 rows below this row as well.

Again, I really appreciate your help.

 

[michaelsmith559]

See if this works:

Sub Copy_Range()
Dim rng As Range, lastRow As Long

lastRow = Range("A1").End(xlDown).Row

With Sheets("Sheet1")
    For r = 1 To lastRow
        Set rng = Sheets("Sheet1").Range(Cells(r, 1), Cells(r, 6))
            If IsEmpty(Sheets("Sheet1").Range("F" & r).Value) = True Then
                Exit Sub
            Else
            If IsEmpty(Sheets("Sheet2").Range("A1048576").End(xlUp).Value) = True Then
                Worksheets("Sheet2").Range("A1048576").End(xlUp).Resize(rng.Rows.Count, rng.Columns.Count). _
                Cells.Value = rng.Cells.Value
            Else
                Worksheets("Sheet2").Range("A1048576").End(xlUp).Offset(1, 0).Resize(rng.Rows.Count, rng.Columns.Count). _
                    Cells.Value = rng.Cells.Value
            End If
            End If
    Next r
End With
End Sub

 

[rplohocky]

This is closer to what I am looking for. This checks F1 to see if their is data and then copies A1:F1 to "Sheet 2" and copies all the rows below as well, this part works great. I need this macro to check F2 to see if their is data and copy cells A2:F2 to "Sheet 2" and then check F3 and see if their is data and copy A2:F3 to "Sheet 2" and so on for the next 20 rows. Basically this macro will look in column F starting at row 1 down to row 20 to see if their is data in any of the cells and then copy the data in cells 1,2,3,4,5,6 into "Sheet 2".

Look in cell F1 copy all data in cells A1, B1, C1, D1, E1 and F1, then look in the next row. If F1 is blank skip to next row.

Look in cell F2 copy all data in cells A2, B2, C2, D2, E2 and F2, then look in the next row. If F2 is blank skip to next row.

Look in cell F3 copy all data in cells A3, B3, C3, D3, E3 and F3, then look in the next row. If F3 is blank skip to next row.

Look in cell F4 copy all data in cells A4, B4, C4, D4, E4 and F4, then look in the next row. If F4 is blank skip to next row.

and so on down to F20.

Thanks again.

 

[michaelsmith559]

It should be doing that

 

[michaelsmith559]

Sorry, you need to remove the Exit Sub after the isempty line.