VBA copy column from two sheets to master in sequence

[msarfaraz]

Sheet1

Name	Desc	Unit	Amount
ABC	Technical	5	1000
DEF	Electronic	10	2000
GHK	Mattel	15	3000
LMN	Glass	25	4000

this sheet has many records

Sheet2

Name	Desc	Unit	Amount
TTG	Wire	4	5678
EEF	Clone	2	6789
HJK	Acid	2	56789

this sheet has many records



MASTER Sheet where data need to copy paste
MASTER

Name	Desc	Unit	Amount
ABC	Technical	5	1000
DEF	Electronic	10	2000
GHK	Mattel	15	3000
LMN	Glass	25	4000
TTG	Wire	4	5678
EEF	Clone	2	6789
HJK	Acid	2	56789

So i need a VBA which give me copy and paste data from sheet1 and sheet2 to Master sheet

 

[Trebor76]

Hi msarfaraz,

Try this:

Option Explicit
Sub Macro1()

    Dim lngLastRow As Long
    Dim lngPasteRow As Long
    Dim wsSource As Worksheet
    Dim wsDestin As Worksheet
    Dim varMySheet As Variant
    
    Application.ScreenUpdating = False
    
    Set wsDestin = ThisWorkbook.Sheets("Master")
    
    For Each varMySheet In Array("Sheet1", "Sheet2")
        Set wsSource = ThisWorkbook.Sheets(CStr(varMySheet))
        If WorksheetFunction.CountA(wsSource.Cells) > 0 Then
            lngLastRow = wsSource.Range("A:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        End If
        If WorksheetFunction.CountA(wsDestin.Cells) > 0 Then
            lngPasteRow = wsDestin.Range("A:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
        End If
        If lngLastRow >= 2 And lngPasteRow >= 2 Then
            wsSource.Range("A2:D" & lngLastRow).Copy Destination:=wsDestin.Range("A" & lngPasteRow & ":D" & lngPasteRow)
        End If
    Next varMySheet
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

 

[msarfaraz]

Hi msarfaraz,

Try this:

Option Explicit
Sub Macro1()

    Dim lngLastRow As Long
    Dim lngPasteRow As Long
    Dim wsSource As Worksheet
    Dim wsDestin As Worksheet
    Dim varMySheet As Variant
   
    Application.ScreenUpdating = False
   
    Set wsDestin = ThisWorkbook.Sheets("Master")
   
    For Each varMySheet In Array("Sheet1", "Sheet2")
        Set wsSource = ThisWorkbook.Sheets(CStr(varMySheet))
        If WorksheetFunction.CountA(wsSource.Cells) > 0 Then
            lngLastRow = wsSource.Range("A:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        End If
        If WorksheetFunction.CountA(wsDestin.Cells) > 0 Then
            lngPasteRow = wsDestin.Range("A:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
        End If
        If lngLastRow >= 2 And lngPasteRow >= 2 Then
            wsSource.Range("A2:D" & lngLastRow).Copy Destination:=wsDestin.Range("A" & lngPasteRow & ":D" & lngPasteRow)
        End If
    Next varMySheet
   
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

Thanks Robert it work perfectly

 

[Trebor76]

Thanks for letting us know and you're welcome.