How to copy columns from two different sheets into one sheet

0
votes

I'm working on a task and I need to copy specific columns from Sheet1 and Sheet2 into Sheet3.

The sheet where the data is supposed to be copied starts at row 14. Also the data from Sheet1 as well as Sheet2 varies in length.

I've already found a way to copy the data from Sheet1 to sheet3 (by researching). The problem is when I try to copy data from sheet2 to sheet3, my code just overwrites the data in sheet3 that was copied from sheet1.

I want my code to copy the data from sheet2 to sheet3 and place it directly below the data that was copied from sheet1. And since the data from sheet1 may vary (it could contain 0 rows or 100 rows). 

Sub copyDataFromTwoSheetsIntoOneSheet()

With Sheets("Sheet1")
.AutoFilterMode = False
LR = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("B14:O" & LR).AutoFilter Field:=14, Criteria1:="<>"

If LR > 1 Then
    .Range("B14:B" & LR).Copy
    Sheets("Sheet3").Range("B14").PasteSpecial xlPasteValues

    .Range("C14:C" & LR).Copy
    Sheets("Sheet3").Range("C14").PasteSpecial xlPasteValues

    .Range("D14:D" & LR).Copy
    Sheets("Sheet3").Range("D14").PasteSpecial xlPasteValues

    .Range("E14:E" & LR).Copy
    Sheets("Sheet3").Range("E14").PasteSpecial xlPasteValues

    .Range("F14:F" & LR).Copy
    Sheets("Sheet3").Range("F14").PasteSpecial xlPasteValues

    .Range("G14:G" & LR).Copy
    Sheets("Sheet3").Range("G14").PasteSpecial xlPasteValues

    .Range("H14:H" & LR).Copy
    Sheets("Sheet3").Range("H14").PasteSpecial xlPasteValues

    .Range("I14:I" & LR).Copy
    Sheets("Sheet3").Range("I14").PasteSpecial xlPasteValues

    .Range("J14:J" & LR).Copy
    Sheets("Sheet3").Range("J14").PasteSpecial xlPasteValues

    .Range("O14:O" & LR).Copy
    Sheets("Sheet3").Range("N14").PasteSpecial xlPasteValues

End If
.AutoFilterMode = False
End With

With Sheets("Sheet2")
.AutoFilterMode = False
LR = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("B14:M" & LR).AutoFilter Field:=12, Criteria1:="<>"


If LR > 1 Then

    .Range("B14:B" & LR).Copy
    Sheets("Sheet3").Range("B14").PasteSpecial xlPasteValues

    .Range("C14:C" & LR).Copy
    Sheets("Sheet3").Range("C14").PasteSpecial xlPasteValues

    .Range("D14:D" & LR).Copy
    Sheets("Sheet3").Range("D14").PasteSpecial xlPasteValues

    .Range("E14:E" & LR).Copy
    Sheets("Sheet3").Range("E14").PasteSpecial xlPasteValues

    .Range("F14:F" & LR).Copy
    Sheets("Sheet3").Range("F14").PasteSpecial xlPasteValues

    .Range("G14:G" & LR).Copy
    Sheets("Sheet3").Range("G14").PasteSpecial xlPasteValues

    .Range("H14:H" & LR).Copy
    Sheets("Sheet3").Range("H14").PasteSpecial xlPasteValues

    .Range("I14:I" & LR).Copy
    Sheets("Sheet3").Range("I14").PasteSpecial xlPasteValues

    .Range("J14:J" & LR).Copy
    Sheets("Sheet3").Range("J14").PasteSpecial xlPasteValues

    .Range("M14:M" & LR).Copy
    Sheets("Sheet3").Range("N14").PasteSpecial xlPasteValues

End If
.AutoFilterMode = False

End Sub
2
vbaexcel

2 Answers

0
votes

For starters,

.Range("B14:B" & LR).Copy
Sheets("Sheet3").Range("B14").PasteSpecial xlPasteValues

.Range("C14:C" & LR).Copy
Sheets("Sheet3").Range("C14").PasteSpecial xlPasteValues

.Range("D14:D" & LR).Copy
Sheets("Sheet3").Range("D14").PasteSpecial xlPasteValues

.Range("E14:E" & LR).Copy
Sheets("Sheet3").Range("E14").PasteSpecial xlPasteValues

.Range("F14:F" & LR).Copy
Sheets("Sheet3").Range("F14").PasteSpecial xlPasteValues

.Range("G14:G" & LR).Copy
Sheets("Sheet3").Range("G14").PasteSpecial xlPasteValues

.Range("H14:H" & LR).Copy
Sheets("Sheet3").Range("H14").PasteSpecial xlPasteValues

.Range("I14:I" & LR).Copy
Sheets("Sheet3").Range("I14").PasteSpecial xlPasteValues

.Range("J14:J" & LR).Copy
Sheets("Sheet3").Range("J14").PasteSpecial xlPasteValues

can be condensed to:

.Range("B14:J" & LR).Copy
Sheets("Sheet3").Range("B14").PasteSpecial xlPasteValues

as it is a contiguous range

As for the pasting below the last data point, you can use something like:

Sheets("Sheet3").Range("B" & rows.count).end(xlup).offset(1,0).PasteSpecial xlPasteValues

Basically it goes up in column B from the last row in the sheet to the last bit of data (Doesn't physically move around but works out the location), then it offsets by 1 row (in other words, 1 cell below the last bit of data)

You can also loop sheet 1 and 2 so you only write the code once, no need for repetition (I took the liberty of declaring your LR variable for you too).

Sub copyDataFromTwoSheetsIntoOneSheet()
Dim X As Long, LR As Long, PasteRow As Long
For X = 1 To 2
    With Sheets("Sheet" & X)
    .AutoFilterMode = False
    LR = .Range("B" & .Rows.Count).End(xlUp).Row
    .Range("B14:O" & LR).AutoFilter Field:=14, Criteria1:="<>"
    If LR > 1 Then
        PasteRow = Sheets("Sheet3").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row
        .Range("B14:J" & LR).Copy
        Sheets("Sheet3").Range("B" & PasteRow).PasteSpecial xlPasteValues
        If X = 1 Then
            .Range("O14:O" & LR).Copy
        Else
            .Range("M14:M" & LR).Copy
        End If
        Sheets("Sheet3").Range("N" & PasteRow).PasteSpecial xlPasteValues
    End If
    .AutoFilterMode = False
    End With
Next
End Sub
0
votes

you could refactor your code as follows:

Option Explicit

Sub copyDataFromTwoSheetsIntoOneSheet()
    Dim nFiltered As Long

    With Sheets("Sheet1")
        .AutoFilterMode = False
        With .Range("O14", .Cells(.Rows.count, "B").End(xlUp))
            .AutoFilter Field:=14, Criteria1:="<>"
            nFiltered = Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) - 1 '<--| count filtered cells excluding header row
            If nFiltered > 0 Then CopyFiltered .Cells, 0, 0, 9, 13, 1, 14
        End With
        .AutoFilterMode = False
    End With

    With Sheets("Sheet2")
        .AutoFilterMode = False
        With .Range("M14", .Cells(.Rows.count, "B").End(xlUp))
            .AutoFilter Field:=12, Criteria1:="<>"
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then CopyFiltered .Cells, IIf(nFiltered > 0, 1, 0), 0, 9, 11, 1, 14
        End With
        .AutoFilterMode = False
    End With
End Sub


Sub CopyFiltered(rng As Range, rowsReduction As Long, firstColumnOffset As Long, firstColumnResize As Long, secondColumnOffset As Long, secondColumnResize As Long, pasteSheetColumnToFindLastRowIn As Long)
    Dim lastRow As Long

    lastRow = WorksheetFunction.Max(14, Sheets("Sheet3").Cells(Rows.count, pasteSheetColumnToFindLastRowIn).End(xlUp).Offset(1).Row) '<--| get Sheet3 passed column row to start pasting from

    With rng.Resize(rng.Rows.count - rowsReduction).Offset(rowsReduction)
        .Offset(, firstColumnOffset).Resize(, firstColumnResize).SpecialCells(xlCellTypeVisible).Copy
        Sheets("Sheet3").Range("B" & lastRow).PasteSpecial xlPasteValues
        Application.CutCopyMode = False

        .Offset(, secondColumnOffset).Resize(, secondColumnResize).SpecialCells(xlCellTypeVisible).Copy
        Sheets("Sheet3").Range("N" & lastRow).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End With
End Sub