Copy 2 columns to last row of sheet removing blanks?

[JumboCactuar]

Hi,
Having trouble with this

I'm wanting to copy from sheet1:
Columns C + G (only rows with data)
To
Sheet2 (columns A+B) last row

So Sheet2 should never have any blanks between rows

Appreciate any help

Was thinking maybe an advanced filter then copying the filtered range to sheet 2 but maybe an easier way

 

[footoo]

What if one of the cells in columns C & G has data and the other one is blank?

 

[JumboCactuar]

What if one of the cells in columns C & G has data and the other one is blank?

Still copy, although they are always either both blank or both not

 

[alansidman]

Option Explicit


Sub foo()
    Dim s1 As Worksheet, s2 As Worksheet
    Dim lrC As Long, lrG As Long, lrA As Long, lrB As Long
    lrC = s1.Range("C" & Rows.Count).End(xlUp).Row
    lrG = s1.Range("G" & Rows.Count).End(xlUp).Row
    Dim i As Long
    Application.ScreenUpdating = False
    For i = 1 To lrC
        lrA = s2.Range("A" & Rows.Count).End(xlUp).Row
        If Not IsNull(s1.Range("C" & i)) Then
            s1.Range("C" & i).Copy s2.Range("A" & lrA + 1)
        End If
    Next i


    For i = 1 To lrG
        lrB = s2.Range("B" & Rows.Count).End(xlUp).Row
        If Not IsNull(s1.Range("G" & i)) Then
            s1.Range("G" & i).Copy s2.Range("B" & lrB + 1)
        End If
    Next i


    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Complete"


End Sub

 

[Trebor76]

Here's my attempt:

Option Explicit
Sub Macro1()

    Dim lngLastRow  As Long
    Dim lngPasteRow As Long
    Dim lngMyRow    As Long
    
    Application.ScreenUpdating = False

    lngLastRow = Sheets("Sheet1").Range("C:C,G:G").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    For lngMyRow = 2 To lngLastRow 'Starts from Row 2. Change to suit if necessary.
        If Len(Sheets("Sheet1").Range("C" & lngMyRow)) > 0 Or Len(Sheets("Sheet1").Range("G" & lngMyRow)) > 0 Then
            If lngPasteRow = 0 Then
                On Error Resume Next 'In case there's data in Sheet2
                    lngPasteRow = Sheets("Sheet2").Range("A:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    If lngPasteRow = 0 Then
                        lngPasteRow = 2 'Default output row if there's no data on Sheet2. Change to suit if necessary.
                    End If
                On Error GoTo 0
            Else
                lngPasteRow = Sheets("Sheet2").Range("A:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            End If
            With Sheets("Sheet2")
                .Range("A" & lngPasteRow) = Sheets("Sheet1").Range("C" & lngMyRow)
                .Range("B" & lngPasteRow) = Sheets("Sheet1").Range("G" & lngMyRow)
            End With
        End If
    Next lngMyRow
    
    Application.ScreenUpdating = True

End Sub

HTH

Robert

 

[footoo]

Another way (assumes both sheets data starts in row 2) :

Sub FT()
Dim lr&
With Sheets("Sheet1")
    lr = .Cells(Rows.Count, "C").End(xlUp).Row
    .Range("C2:C" & lr).Copy Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp)(2)
    .Range("G2:G" & lr).Copy Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp)(2)
End With
On Error Resume Next
Sheets("Sheet2").[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

 

[JumboCactuar]

Thanks for all the solutions, will try in morning.

Forgot to mention but column G has formulas all the way down to row 10000 which return "" until C is populated.

Unsure if this affects row count

 

[footoo]

Thanks for all the solutions, will try in morning.

Forgot to mention but column G has formulas all the way down to row 10000 which return "" until C is populated.

Unsure if this affects row count

Should not affect the macro I posted provided that the blanks in column C are really blanks.

 

[alansidman]

This will affect row count and in the case of my code it will affect the results because you indicated not to move cells that are blank. Your cells in G are populated. My code will not work for you because I looked for cells that are empty/null. I will not amend since you have two other opportunities. If they don't work, then post back and we will amend.

 

[JumboCactuar]

Should not affect the macro I posted provided that the blanks in column C are really blanks.

hi, i tried yours and it copys over the formulas in column G, so ends up outputting as #REF
also i only need values