VBA Copy columns from one sheet to another

M

Melimob

Active Member
Joined
Oct 16, 2011
Messages
396
Office Version
  1. 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
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Sort by date Sort by votes
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
JLGWhiz said:
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
Click to expand...

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:
Upvote 0
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:
Upvote 0
JLGWhiz said:
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
Click to expand...

thanks so much JLGWhiz!
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
Copy paste from one Excel workbook to another with same sheet names and update dates in range
Replies
8
Views
476
Skiier89
S
G
  • Question Question
VBA help - copy cells from specific table to specific table on another sheet.
Replies
0
Views
738
GardianAngelUK
G
H
  • Solved
Pasting Error when copying columns
2 3
Replies
26
Views
863
Vogateer
V
C
  • Question Question
How to automatically paste the data from one sheet to another using VBA
Replies
4
Views
182
Alex Blakenburg
A
C
  • Question Question
Please help clean up my convoluted VBA code. It seems very redundant and repetitive.
Replies
1
Views
419
myall_blues
myall_blues

Forum statistics

Threads
1,223,214
Messages
6,170,774
Members
452,353
Latest member
strainu

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top