VBA Copy columns from one sheet to another

Melimob

Active Member
Joined
Oct 16, 2011
Messages
365
Hi,

I have a probably very frightening piece of code below. It does the trick but is clunky I know. I just don't have the know how to streamline.

Its a very simple request I'm sure...

Copy columns from one sheet based on table headers in to another based on table headers (they are the same header names in both sheets).

Any advice welcome!

thank you

Code:
Sub GetClientData()
'
' GetClientData Macro
'


    Sheets("Clients ").Select
    Range("C3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("C3").Select
    Sheets("ImportCCB").Select
    Range("Table10[Control Centre Company Build]").Select
    Selection.Copy
    Sheets("Clients ").Select
    Range("C3").Select
    ActiveSheet.Paste
    
    Sheets("CC Reconfiguration Data").Select
    Range("b3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.ClearContents
    Range("b3").Select
    Sheets("ImportCCB").Select
    Range("Table10[Control Centre Company Build]").Select
    Selection.Copy
    Sheets("CC Reconfiguration Data").Select
    Range("b3").Select
    ActiveSheet.Paste
    
    Sheets("ImportCCB").Select
    Range("Table10[CompanyID]").Select
    Selection.Copy
    Sheets("CC Reconfiguration Data").Select
    Range("E3").Select
    ActiveSheet.Paste
    
    Sheets("ImportCCB").Select
    Range("Table10[GDS]").Select
    Selection.Copy
    Sheets("CC Reconfiguration Data").Select
    Range("f3").Select
    ActiveSheet.Paste
    
    Sheets("ImportCCB").Select
    Range("Table10[Current Profile PCC]").Select
    Selection.Copy
    Sheets("CC Reconfiguration Data").Select
    Range("h3").Select
    ActiveSheet.Paste
    
    Sheets("ImportCCB").Select
    Range("Table10[Current Offline PCC]").Select
    Selection.Copy
    Sheets("CC Reconfiguration Data").Select
    Range("i3").Select
    ActiveSheet.Paste
    
    Sheets("ImportCCB").Select
    Range("Table10[Current Online PCC]").Select
    Selection.Copy
    Sheets("CC Reconfiguration Data").Select
    Range("J3").Select
    ActiveSheet.Paste
    
    Sheets("ImportCCB").Select
    Range("Table10[Account Number]").Select
    Selection.Copy
    Sheets("CC Reconfiguration Data").Select
    Range("k3").Select
    ActiveSheet.Paste
    
    Sheets("ImportCCB").Select
    Range("Table10[Account Name]").Select
    Selection.Copy
    Sheets("CC Reconfiguration Data").Select
    Range("L3").Select
    ActiveSheet.Paste
    
    Sheets("ImportCCB").Select
    Range("Table10[Current Bar Title/ Company Profile Name]").Select
    Selection.Copy
    Sheets("CC Reconfiguration Data").Select
    Range("M3").Select
    ActiveSheet.Paste
    
End Sub
 

Some videos you may like

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

dnlrsms

New Member
Joined
Apr 16, 2013
Messages
8
Hi Melimob,

Try this.

Code:
Sub GetClientData()

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim ws1_lastrow As Long, ws3_lastrow As Long


Set ws1 = ThisWorkbook.Sheets("Clients ")
Set ws2 = ThisWorkbook.Sheets("ImportCCB")
Set ws3 = ThisWorkbook.Sheets("CC Reconfiguration Data")


ws1_lastrow = ws1.Cells(Rows.Count, 3).End(xlUp).Row
ws3_lastrow = ws3.Cells(Rows.Count, 2).End(xlUp).Row


Application.ScreenUpdating = False


With ws1


    Range("C3:C" & ws1_lastrow).ClearContents
        ws2.Range("Table10[Control Centre Company Build]").Copy
            Range("C3").PasteSpecial (xlPasteValues)


End With


    ws3.Activate
    ws3.Range("B3:B" & ws3_lastrow).Select
    ws3.Range(Selection, Selection.End(xlToRight)).Select
    Selection.ClearContents
    
        ws2.Range("Table10[Control Centre Company Build]").Copy
        ws3.Range("B3").PasteSpecial (xlPasteValues)


            ws2.Range("Table10[CompanyID]").Copy
            Range("E3").PasteSpecial (xlPasteValues)


                ws2.Range("Table10[GDS]").Copy
                ws3.Range("F3").PasteSpecial (xlPasteValues)
    
                    ws2.Range("Table10[Current Profile PCC]").Copy
                    ws3.Range("H3").PasteSpecial (xlPasteValues)


                        ws2.Range("Table10[Current Offline PCC]").Copy
                        ws3.Range("I3").PasteSpecial (xlPasteValues)


                    ws2.Range("Table10[Current Online PCC]").Copy
                    ws3.Range("J3").PasteSpecial (xlPasteValues)
                    
                ws2.Range("Table10[Account Number]").Copy
                ws3.Range("K3").PasteSpecial (xlPasteValues)


            ws2.Range("Table10[Account Name]").Copy
            ws3.Range("L3").PasteSpecial (xlPasteValues)
        
        ws2.Range("Table10[Current Bar Title/ Company Profile Name]").Copy
        ws3.Range("M3").PasteSpecial (xlPasteValues)
    
Application.ScreenUpdating = True


End Sub
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
11,936
Office Version
2013
Platform
Windows
Another form.

Code:
Sub GetClientData3() '
' GetClientData Macro
    With Sheets("Clients ")
    .Range("C3", .Cells(3, 3).End(xlDown)).ClearContents
    End With
    With Sheets("ImportCCB")
        .Range("Table10[Control Centre Company Build]").Copy Sheets("Clients ").Range("C3")
    End With
    With Sheets("CC Reconfiguration Data")
    .Range("b3", .Cells(3, 2).End(xlDown)).EntireRow.ClearContents
    End With
    With Sheets("ImportCCB")
        .Range("Table10[Control Centre Company Build]").Copy Sheets("CC Reconfiguration Data").Range("b3")
        .Range("Table10[CompanyID]").Copy Sheets("CC Reconfiguration Data").Range("E3")
        .Range("Table10[GDS]").Copy Sheets("CC Reconfiguration Data").Range("f3")
        .Range("Table10[Current Profile PCC]").Copy Sheets("CC Reconfiguration Data").Range("h3")
        .Range("Table10[Current Offline PCC]").Copy Sheets("CC Reconfiguration Data").Range("i3")
        .Range("Table10[Current Online PCC]").Copy Sheets("CC Reconfiguration Data").Range("J3")
        .Range("Table10[Account Number]").Copy Sheets("CC Reconfiguration Data").Range("k3")
        .Range("Table10[Account Name]").Copy Sheets("CC Reconfiguration Data").Range("L3")
        .Range("Table10[Current Bar Title/ Company Profile Name]").Copy Sheets("CC Reconfiguration Data").Range("M3")
    End With
End Sub
 

Melimob

Active Member
Joined
Oct 16, 2011
Messages
365
Hi dnlrsms! thank you so much for this. I adapted it slightly.

It almost works... except
1) the data on "ImportCCB" Sheet which is feeding all the others is filtered. It's copying all instead of filtered/visible info. Is there an easy way to adapt this?

2) it's taking a long time to run and giving 'not responding' in between. I tried to do range = range instead of copy but am I right in thinking this is only for individual cells and not to copy rows of data at one time?

Code:
Sub GetClientData()


Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet
Dim ws1_lastrow As Long, ws3_lastrow As Long, ws4_lastrow As Long, ws5_lastrow As Long




Set ws1 = ThisWorkbook.Sheets("Clients ")
Set ws2 = ThisWorkbook.Sheets("ImportCCB")
Set ws3 = ThisWorkbook.Sheets("CC Reconfiguration Data")
Set ws4 = ThisWorkbook.Sheets("Compleat Routines")
Set ws5 = ThisWorkbook.Sheets("Compleat Queueing")


ws1_lastrow = ws1.Cells(Rows.Count, 3).End(xlUp).Row
ws3_lastrow = ws3.Cells(Rows.Count, 2).End(xlUp).Row
ws4_lastrow = ws4.Cells(Rows.Count, 2).End(xlUp).Row
ws5_lastrow = ws5.Cells(Rows.Count, 2).End(xlUp).Row






Application.ScreenUpdating = False




With ws1


        ws1.Range("C3:C" & ws1_lastrow).ClearContents
        ws2.Range("Table10[Control Centre Company Build]").Copy
        ws1.Range("C3").PasteSpecial (xlPasteValues)




End With






        ws3.Activate
   ' ws3.Range("B3:B" & ws3_lastrow).Select
   ' ws3.Range(Selection, Selection.End(xlToRight)).Select
   ' Selection.ClearContents


        ws3.Range("B3").ListObject.DataBodyRange.ClearContents


        ws2.Range("Table10[Control Centre Company Build]").Copy
        ws3.Range("B3").PasteSpecial (xlPasteValues)




            ws2.Range("Table10[CompanyID]").Copy
            ws3.Range("E3").PasteSpecial (xlPasteValues)




                ws2.Range("Table10[GDS]").Copy
                ws3.Range("F3").PasteSpecial (xlPasteValues)
    
                    ws2.Range("Table10[Current Profile PCC]").Copy
                    ws3.Range("H3").PasteSpecial (xlPasteValues)




                        ws2.Range("Table10[Current Offline PCC]").Copy
                        ws3.Range("I3").PasteSpecial (xlPasteValues)




                    ws2.Range("Table10[Current Online PCC]").Copy
                    ws3.Range("J3").PasteSpecial (xlPasteValues)
                    
                ws2.Range("Table10[Account Number]").Copy
                ws3.Range("K3").PasteSpecial (xlPasteValues)




            ws2.Range("Table10[Account Name]").Copy
            ws3.Range("L3").PasteSpecial (xlPasteValues)
        
        ws2.Range("Table10[Current Bar Title/ Company Name]").Copy
        ws3.Range("M3").PasteSpecial (xlPasteValues)
    
        ws4.Activate
        ws4.Range("B3:B" & ws4_lastrow).Select
        ws4.Range(Selection, Selection.End(xlToRight)).Select
        Selection.ClearContents


        ws2.Range("Table10[Control Centre Company Build]").Copy
        ws4.Range("B3").PasteSpecial (xlPasteValues)


        ws5.Activate
        'ws5.Range("A3").ListObject.DataBodyRange.ClearContents
        
        ws5.Range("B6:B" & ws5_lastrow).Select
        ws5.Range(Selection, Selection.End(xlToRight)).Select
        Selection.ClearContents
        
        
        ws2.Range("Table10[Control Centre Company Build]").Copy
        ws5.Range("B6").PasteSpecial (xlPasteValues)
        
        ws2.Range("Table10[Mobile]").Copy
        ws5.Range("E6").PasteSpecial (xlPasteValues)
        
        ws2.Range("Table10[Tripcheck]").Copy
        ws5.Range("F6").PasteSpecial (xlPasteValues)
        
        ws2.Range("Table10[Tripgood]").Copy
        ws5.Range("G6").PasteSpecial (xlPasteValues)
    
Application.ScreenUpdating = True




End Sub
many thanks in advance
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
11,936
Office Version
2013
Platform
Windows
See if this is more to your needs.

Code:
Sub GetClientData3() '
' GetClientData Macro
    With Sheets("Clients ")
    .Range("C3", .Cells(3, 3).End(xlDown)).ClearContents
    End With
    With Sheets("ImportCCB")
        .Range("Table10[Control Centre Company Build]").Copy Sheets("Clients ").Range("C3")
    End With
    With Sheets("CC Reconfiguration Data")
    .Range("b3", .Cells(3, 2).End(xlDown)).EntireRow.ClearContents
    End With
    With Sheets("ImportCCB")
        .Range("Table10[Control Centre Company Build]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("b3")
        .Range("Table10[CompanyID]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("E3")
        .Range("Table10[GDS]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("f3")
        .Range("Table10[Current Profile PCC]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("h3")
        .Range("Table10[Current Offline PCC]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("i3")
        .Range("Table10[Current Online PCC]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("J3")
        .Range("Table10[Account Number]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("k3")
        .Range("Table10[Account Name]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("L3")
        .Range("Table10[Current Bar Title/ Company Profile Name]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("M3")
    End With
End Sub
 

dnlrsms

New Member
Joined
Apr 16, 2013
Messages
8
Hi Melimob,

I will suggest that you try JLGWhiz code. JLGWhiz's solution includes .SpecialCells(xlCellTypeVisible) that will only copy the visible data from your filtered table. I really like his solution because it's easy to read and you can expand on it to include your extra two tabs, Compleat Routines & Compleat Queueing*.

* Complete Routines & Complete Queuing
 

Melimob

Active Member
Joined
Oct 16, 2011
Messages
365
See if this is more to your needs.

Code:
Sub GetClientData3() '
' GetClientData Macro
    With Sheets("Clients ")
    .Range("C3", .Cells(3, 3).End(xlDown)).ClearContents
    End With
    With Sheets("ImportCCB")
        .Range("Table10[Control Centre Company Build]").Copy Sheets("Clients ").Range("C3")
    End With
    With Sheets("CC Reconfiguration Data")
    .Range("b3", .Cells(3, 2).End(xlDown)).EntireRow.ClearContents
    End With
    With Sheets("ImportCCB")
        .Range("Table10[Control Centre Company Build]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("b3")
        .Range("Table10[CompanyID]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("E3")
        .Range("Table10[GDS]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("f3")
        .Range("Table10[Current Profile PCC]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("h3")
        .Range("Table10[Current Offline PCC]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("i3")
        .Range("Table10[Current Online PCC]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("J3")
        .Range("Table10[Account Number]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("k3")
        .Range("Table10[Account Name]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("L3")
        .Range("Table10[Current Bar Title/ Company Profile Name]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("CC Reconfiguration Data").Range("M3")
    End With
End Sub
Thank you both so so much!!
I can't tell you how much I appreciate all your time for helping me JLGWhiz & dnlrsms!

I'm just trying to figure out how I can adapt this to paste special?

I tried:

Code:
 .Range("Table10[Control Centre Company Build]") _
        .SpecialCells(xlCellTypeVisible).Copy .PasteSpecial(xlPasteValues).Sheets("Clients ").Range("C3")
and

Code:
        .Range("Table10[CompanyID]") _
        .SpecialCells(xlCellTypeVisible).Copy Sheets("Clients ").Range("F3").PasteSpecial(xlPasteValues)

but neither work?

Also, is this correct as I added it to remove the databody range but leave any formulas:

Code:
  With Sheets("Compleat Routines")
        .DataBodyRange.SpecialCells _
          (xlCellTypeConstants, 23).ClearContents
    End With
thanks again!
 
Last edited:

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
11,936
Office Version
2013
Platform
Windows
the pastespecial has to be on a separate line from the copy statement.

Code:
.Range("Table10[CompanyID]").SpecialCells(xlCellTypeVisible).Copy 
Sheets("Clients ").Range("F3").PasteSpecial xlPasteValues
 
Last edited:

Melimob

Active Member
Joined
Oct 16, 2011
Messages
365
the pastespecial has to be on a separate line from the copy statement.

Code:
.Range("Table10[CompanyID]").SpecialCells(xlCellTypeVisible).Copy 
Sheets("Clients ").Range("F3").PasteSpecial xlPasteValues
thanks so much JLGWhiz!
 

Watch MrExcel Video

Forum statistics

Threads
1,099,914
Messages
5,471,476
Members
406,764
Latest member
ExcelMaker007

This Week's Hot Topics

Top