[Excel VBA]Transfer/Copy different columns from different sheets then paste to master file

**dylanrose** · 04-29-2015, 10:59 PM

Hi,

I'm having a hard time in making my code as short and simple as possible. What my code does is combining different data from different columns from different sheets to one master file.

What I want to happen is to have the code as short and simple and loop it in different sheets.

Here's my code:

Sub CombineSheets()

'Variables to be used in For Loop
    Dim NR As Long, LR As Long
    Dim sht, sht2 As Worksheet
'Variables to be used for update button
    Dim Note As String, Answer As String

    Set sht = Sheets("AP")
    Set sht2 = Sheets("Data")
    
    LR = sht.Range("F" & Rows.Count).End(xlUp).Row
    NR = sht2.Range("F" & Rows.Count).End(xlUp).Row + 1
    
        'supplier
            sht.Range("CE2:CE" & LR).Copy
            sht2.Range("B" & NR).PasteSpecial xlPasteValues
        'other changes
            'sht.Range("DJ2:DJ" & LR).Copy
            'sht2.Range("C" & NR).PasteSpecial xlPasteValues
        'listing name
            sht.Range("F2:F" & LR).Copy
            sht2.Range("D" & NR).PasteSpecial xlPasteValues
        'offer type
            sht.Range("DD2:DD" & LR).Copy
            sht2.Range("E" & NR).PasteSpecial xlPasteValues
        'bedrooms
            sht.Range("BH2:BH" & LR).Copy
            sht2.Range("F" & NR).PasteSpecial xlPasteValues
        'bathroom
            sht.Range("BI2:BI" & LR).Copy
            sht2.Range("G" & NR).PasteSpecial xlPasteValues
        'floor area
            'sht.Range("DD2:DD" & LR).Copy
            'sht2.Range("H" & NR).PasteSpecial xlPasteValues
        'land area
            'sht.Range("AS2:AS" & LR).Copy
            'sht2.Range("I" & NR).PasteSpecial xlPasteValues
        'city
            sht.Range("AM2:AM" & LR).Copy
            sht2.Range("J" & NR).PasteSpecial xlPasteValues
        'address
            sht.Range("AO2:AO" & LR).Copy
            sht2.Range("K" & NR).PasteSpecial xlPasteValues
        'Price
            sht.Range("AS2:AS" & LR).Copy
            sht2.Range("L" & NR).PasteSpecial xlPasteValues
        'sku_config
            sht.Range("CI2:CI" & LR).Copy
            sht2.Range("M" & NR).PasteSpecial xlPasteValues
        'url_details
            sht.Range("DC2:DC" & LR).Copy
            sht2.Range("N" & NR).PasteSpecial xlPasteValues
            
            LP = Sheets("Data").Cells(Sheets("Data").Rows.Count, "F").End(xlUp).Row
            sht2.Activate
            Application.CutCopyMode = False
            
            If NR > 2 Then
            Else
                'none
            End If
            
    Set sht = Sheets("CO")
    Set sht2 = Sheets("Data")
    
    LR = sht.Range("F" & Rows.Count).End(xlUp).Row
    NR = sht2.Range("F" & Rows.Count).End(xlUp).Row + 1
    
        'supplier
            sht.Range("CC2:CC" & LR).Copy
            sht2.Range("B" & NR).PasteSpecial xlPasteValues
        'other changes
            'sht.Range("DJ2:DJ" & LR).Copy
            'sht2.Range("C" & NR).PasteSpecial xlPasteValues
        'listing name
            sht.Range("F2:F" & LR).Copy
            sht2.Range("D" & NR).PasteSpecial xlPasteValues
        'offer type
            sht.Range("DB2:DB" & LR).Copy
            sht2.Range("E" & NR).PasteSpecial xlPasteValues
        'bedrooms
            'sht.Range("BH2:BH" & LR).Copy
            'sht2.Range("F" & NR).PasteSpecial xlPasteValues
        'bathroom
            'sht.Range("BI2:BI" & LR).Copy
            'sht2.Range("G" & NR).PasteSpecial xlPasteValues
        'floor area
            sht.Range("BI2:BI" & LR).Copy
            sht2.Range("H" & NR).PasteSpecial xlPasteValues
        'land area
            sht.Range("BK2:BK" & LR).Copy
            sht2.Range("I" & NR).PasteSpecial xlPasteValues
        'city
            sht.Range("AM2:AM" & LR).Copy
            sht2.Range("J" & NR).PasteSpecial xlPasteValues
        'address
            sht.Range("AO2:AO" & LR).Copy
            sht2.Range("K" & NR).PasteSpecial xlPasteValues
        'Price
            sht.Range("AS2:AS" & LR).Copy
            sht2.Range("L" & NR).PasteSpecial xlPasteValues
        'sku_config
            sht.Range("CG2:CG" & LR).Copy
            sht2.Range("M" & NR).PasteSpecial xlPasteValues
        'url_details
            sht.Range("DA2:DA" & LR).Copy
            sht2.Range("N" & NR).PasteSpecial xlPasteValues
            
            LP = Sheets("Data").Cells(Sheets("Data").Rows.Count, "F").End(xlUp).Row
            sht2.Activate
            Application.CutCopyMode = False
            
            If NR > 2 Then
            Else
                'none
            End If
        
    Set sht = Sheets("CD")
    Set sht2 = Sheets("Data")
    
    LR = sht.Range("F" & Rows.Count).End(xlUp).Row
    NR = sht2.Range("F" & Rows.Count).End(xlUp).Row + 1
    
        'supplier
            sht.Range("CE2:CE" & LR).Copy
            sht2.Range("B" & NR).PasteSpecial xlPasteValues
        'other changes
            'sht.Range("DJ2:DJ" & LR).Copy
            'sht2.Range("C" & NR).PasteSpecial xlPasteValues
        'listing name
            sht.Range("M2:M" & LR).Copy
            sht2.Range("D" & NR).PasteSpecial xlPasteValues
        'offer type
            sht.Range("DD2:DD" & LR).Copy
            sht2.Range("E" & NR).PasteSpecial xlPasteValues
        'bedrooms
            sht.Range("BH2:BH" & LR).Copy
            sht2.Range("F" & NR).PasteSpecial xlPasteValues
        'bathroom
            sht.Range("BI2:BI" & LR).Copy
            sht2.Range("G" & NR).PasteSpecial xlPasteValues
        'floor area
            sht.Range("BK2:BK" & LR).Copy
            sht2.Range("H" & NR).PasteSpecial xlPasteValues
        'land area
            'sht.Range("BK2:BK" & LR).Copy
            'sht2.Range("I" & NR).PasteSpecial xlPasteValues
        'city
            sht.Range("AM2:AM" & LR).Copy
            sht2.Range("J" & NR).PasteSpecial xlPasteValues
        'address
            sht.Range("AO2:AO" & LR).Copy
            sht2.Range("K" & NR).PasteSpecial xlPasteValues
        'Price
            sht.Range("AS2:AS" & LR).Copy
            sht2.Range("L" & NR).PasteSpecial xlPasteValues
        'sku_config
            sht.Range("CI2:CI" & LR).Copy
            sht2.Range("M" & NR).PasteSpecial xlPasteValues
        'url_details
            sht.Range("DC2:DC" & LR).Copy
            sht2.Range("N" & NR).PasteSpecial xlPasteValues
            
            LP = Sheets("Data").Cells(Sheets("Data").Rows.Count, "F").End(xlUp).Row
            sht2.Activate
            Application.CutCopyMode = False
            
            If NR > 2 Then
            Else
                'none
            End If

    Set sht = Sheets("DE")
    Set sht2 = Sheets("Data")
    
    LR = sht.Range("F" & Rows.Count).End(xlUp).Row
    NR = sht2.Range("F" & Rows.Count).End(xlUp).Row + 1
    
        'supplier
            sht.Range("CA2:CA" & LR).Copy
            sht2.Range("B" & NR).PasteSpecial xlPasteValues
        'other changes
            'sht.Range("DJ2:DJ" & LR).Copy
            'sht2.Range("C" & NR).PasteSpecial xlPasteValues
        'listing name
            sht.Range("D2:D" & LR).Copy
            sht2.Range("D" & NR).PasteSpecial xlPasteValues
        'offer type
            sht.Range("CZ2:CZ" & LR).Copy
            sht2.Range("E" & NR).PasteSpecial xlPasteValues
        'bedrooms
            sht.Range("BI2:BI" & LR).Copy
            sht2.Range("F" & NR).PasteSpecial xlPasteValues
        'bathroom
            sht.Range("BJ2:BJ" & LR).Copy
            sht2.Range("G" & NR).PasteSpecial xlPasteValues
        'floor area
            sht.Range("BK2:BK" & LR).Copy
            sht2.Range("H" & NR).PasteSpecial xlPasteValues
        'land area
            'sht.Range("BK2:BK" & LR).Copy
            'sht2.Range("I" & NR).PasteSpecial xlPasteValues
        'city
            sht.Range("AM2:AM" & LR).Copy
            sht2.Range("J" & NR).PasteSpecial xlPasteValues
        'address
            sht.Range("AO2:AO" & LR).Copy
            sht2.Range("K" & NR).PasteSpecial xlPasteValues
        'Price
            sht.Range("AR2:AR" & LR).Copy
            sht2.Range("L" & NR).PasteSpecial xlPasteValues
        'sku_config
            sht.Range("CE2:CE" & LR).Copy
            sht2.Range("M" & NR).PasteSpecial xlPasteValues
        'url_details
            sht.Range("CY2:CY" & LR).Copy
            sht2.Range("N" & NR).PasteSpecial xlPasteValues
            
            LP = Sheets("Data").Cells(Sheets("Data").Rows.Count, "F").End(xlUp).Row
            sht2.Activate
            Application.CutCopyMode = False
            
            If NR > 2 Then
            Else
                'none
            End If

    Set sht = Sheets("HO")
    Set sht2 = Sheets("Data")
    
    LR = sht.Range("F" & Rows.Count).End(xlUp).Row
    NR = sht2.Range("F" & Rows.Count).End(xlUp).Row + 1
    
        'supplier
            sht.Range("CD2:CD" & LR).Copy
            sht2.Range("B" & NR).PasteSpecial xlPasteValues
        'other changes
            'sht.Range("DJ2:DJ" & LR).Copy
            'sht2.Range("C" & NR).PasteSpecial xlPasteValues
        'listing name
            sht.Range("F2:F" & LR).Copy
            sht2.Range("D" & NR).PasteSpecial xlPasteValues
        'offer type
            sht.Range("DC2:DC" & LR).Copy
            sht2.Range("E" & NR).PasteSpecial xlPasteValues
        'bedrooms
            sht.Range("BH2:BH" & LR).Copy
            sht2.Range("F" & NR).PasteSpecial xlPasteValues
        'bathroom
            sht.Range("BI2:BI" & LR).Copy
            sht2.Range("G" & NR).PasteSpecial xlPasteValues
        'floor area
            sht.Range("BK2:BK" & LR).Copy
            sht2.Range("H" & NR).PasteSpecial xlPasteValues
        'land area
            sht.Range("BL2:BL" & LR).Copy
            sht2.Range("I" & NR).PasteSpecial xlPasteValues
        'city
            sht.Range("AM2:AM" & LR).Copy
            sht2.Range("J" & NR).PasteSpecial xlPasteValues
        'address
            sht.Range("AO2:AO" & LR).Copy
            sht2.Range("K" & NR).PasteSpecial xlPasteValues
        'Price
            sht.Range("AS2:AS" & LR).Copy
            sht2.Range("L" & NR).PasteSpecial xlPasteValues
        'sku_config
            sht.Range("CH2:CH" & LR).Copy
            sht2.Range("M" & NR).PasteSpecial xlPasteValues
        'url_details
            sht.Range("DB2:DB" & LR).Copy
            sht2.Range("N" & NR).PasteSpecial xlPasteValues
            
            LP = Sheets("Data").Cells(Sheets("Data").Rows.Count, "F").End(xlUp).Row
            sht2.Activate
            Application.CutCopyMode = False
            
            If NR > 2 Then
            Else
                'none
            End If

    Set sht = Sheets("LA")
    Set sht2 = Sheets("Data")
    
    LR = sht.Range("F" & Rows.Count).End(xlUp).Row
    NR = sht2.Range("F" & Rows.Count).End(xlUp).Row + 1
    
        'supplier
            sht.Range("BU2:BU" & LR).Copy
            sht2.Range("B" & NR).PasteSpecial xlPasteValues
        'other changes
            'sht.Range("DJ2:DJ" & LR).Copy
            'sht2.Range("C" & NR).PasteSpecial xlPasteValues
        'listing name
            sht.Range("F2:F" & LR).Copy
            sht2.Range("D" & NR).PasteSpecial xlPasteValues
        'offer type
            sht.Range("CT2:CT" & LR).Copy
            sht2.Range("E" & NR).PasteSpecial xlPasteValues
        'bedrooms
            'sht.Range("BH2:BH" & LR).Copy
            'sht2.Range("F" & NR).PasteSpecial xlPasteValues
        'bathroom
            'sht.Range("BI2:BI" & LR).Copy
            'sht2.Range("G" & NR).PasteSpecial xlPasteValues
        'floor area
            'sht.Range("BK2:BK" & LR).Copy
            'sht2.Range("H" & NR).PasteSpecial xlPasteValues
        'land area
            sht.Range("BH2:BH" & LR).Copy
            sht2.Range("I" & NR).PasteSpecial xlPasteValues
        'city
            sht.Range("AM2:AM" & LR).Copy
            sht2.Range("J" & NR).PasteSpecial xlPasteValues
        'address
            sht.Range("AO2:AO" & LR).Copy
            sht2.Range("K" & NR).PasteSpecial xlPasteValues
        'Price
            sht.Range("AS2:AS" & LR).Copy
            sht2.Range("L" & NR).PasteSpecial xlPasteValues
        'sku_config
            sht.Range("BY2:BY" & LR).Copy
            sht2.Range("M" & NR).PasteSpecial xlPasteValues
        'url_details
            sht.Range("CS2:CS" & LR).Copy
            sht2.Range("N" & NR).PasteSpecial xlPasteValues
            
            LP = Sheets("Data").Cells(Sheets("Data").Rows.Count, "F").End(xlUp).Row
            sht2.Activate
            Application.CutCopyMode = False
            
            If NR > 2 Then
            Else
                'none
            End If

End Sub

[Excel VBA]Transfer/Copy different columns from different sheets then paste to master file

LinkBack

Thread Tools

Rate This Thread

Display

Threaded View

[Excel VBA]Transfer/Copy different columns from different sheets then paste to master file

Thread Information

Users Browsing this Thread

Similar Threads

Copy and Paste data automatically from master sheet to other sheets

Macro to transfer data from multiple workbooks into separate sheets of master file

Copy/paste data from different work sheets to master sheet

[SOLVED] Copy paste values from sheets into one master sheet

Help with Copy and Paste Macro from Master sheet to other sheets

Bookmarks

Bookmarks

Posting Permissions