VB - Copy Range - Moving columns that are not hidden to another tab

nss12

New Member
Joined
Jun 18, 2015
Messages
25
Good morning!

I am working on code that will distribute a range of cells from one tab to another.

Here's how it works:


Tab.2 has 10 columns of data and thousands of rows of customer information.


Customer #, Customer Code, Mr/Mrs/Ms, Name, Age, School, School Zone, Zip Code, City, State


What I want to do is to be able to hide some of these columns in Tab.2 (it can be random - it is dependent on the column headers in Tab.1), and then copy that range of cells from Tab.2 to an area on Tab.1.

This is what Tab.1 looks like:


Customer #, Name, Age, School, Zip Code




The code that I am using is pasted below. I am not sure how to modify it to bring in only the columns of data that are shown (not that are hidden. Again, any of the columns can be hidden - it's up to the user to determine what they want on Tab.1).



Sub CopyRangeToAnotherSheet()

Sheets("Tab.2").Range("A1:M999").Copy Destination:=Sheets("Tab.1").Range("B2:N999")

End Sub




Does anyone know any way of going about this?


Thank you!
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
See if this works:
Code:
Sub CopyBasedOnHeader()

Dim wks1    As Excel.Worksheet: Set wks1 = Sheets("Tab.1")
Dim wks2    As Excel.Worksheet: Set wks2 = Sheets("Tab.2")
Dim rng1    As Excel.Range
Dim rng2    As Excel.Range

Dim arrTemp()   As Variant

Dim x           As Long
Dim LC1         As Long
Dim LC2         As Long

Dim msg         As String

    LC1 = wks1.Cells(1, Columns.Count).End(xlToLeft).Column
    LC2 = wks2.Cells(1, Columns.Count).End(xlToLeft).Column
    
    Application.ScreenUpdating = False
    
    For Each rng1 In wks1.Cells(1, 1).Resize(1, LC1)
    
        On Error Resume Next
            Set rng2 = wks2.Cells(1, 1).Resize(1, LC2).speicalcells(xlCellTypeVisible).Find(what:=rng1.Value, LookIn:=xlValues, lookat:=xlWhole).Offset(1)
        On Error GoTo 0
        
        If Not rng2 Is Nothing Then
            x = wks2.Cells(Rows.Count, rng2.Column).End(xlUp).Row
            arrTemp = rng2.Resize(x - 1).Value
            rng1.Offset(1).Resize(x - 1).Value = arrTemp
            Erase arrTemp
            Set rng2 = Nothing
        Else
            msg = "Header: " & rng1 & " not found or is hidden. Continue with next header [(Yes) or stop macro (No)]?"
            If MsgBox(msg, vbYesNo, "Header not found") = vbNo Then End
        End If
    
    Next rng1
        
    Application.ScreenUpdating = True
        
Set wks1 = Nothing: Set wks2 = Nothing
        
End Sub
 
Upvote 0
Do the headers in Tab.1 exactly match the headers in Tab.2? It worked on a test copy I have here and the message box will only appear if it can't find an exact match.
 
Upvote 0
Yes they do! I think I may be missing something - the headers do match exactly, but they're located in different places on each tab (for instance, Tab.2's columns are in row 15, whereas Tab.1's columns are in row 1). I'm quite the novice on VB - do you know how I can go about fixing this?
 
Upvote 0
Changes in blue:
Rich (BB code):
Sub CopyBasedOnHeader_v2()

Dim wks1    As Excel.Worksheet: Set wks1 = Sheets("Tab.1")
Dim wks2    As Excel.Worksheet: Set wks2 = Sheets("Tab.2")
Dim rng1    As Excel.Range
Dim rng2    As Excel.Range

Dim arrTemp()   As Variant

Dim x           As Long
Dim LC1         As Long
Dim LC2         As Long

Dim msg         As String

    LC1 = wks1.Cells(1, Columns.Count).End(xlToLeft).Column
    LC2 = wks2.Cells(1, Columns.Count).End(xlToLeft).Column
    
    Application.ScreenUpdating = False
    
   'Search across row1 in Tab.1
    For Each rng1 In wks1.Cells(1, 1).Resize(1, LC1)
    
        On Error Resume Next
            'Match against values in Tab.2 row 15
            Set rng2 = wks2.Cells(15, 1).Resize(1, LC2).speicalcells(xlCellTypeVisible).Find(what:=rng1.Value, LookIn:=xlValues, lookat:=xlWhole).Offset(1)
        On Error GoTo 0
        
        If Not rng2 Is Nothing Then
            x = wks2.Cells(Rows.Count, rng2.Column).End(xlUp).Row
            arrTemp = rng2.Resize(x - rng2.row + 1).Value
            rng1.Offset(1).Resize(x - rng2.row + 1).Value = arrTemp
            Erase arrTemp
            Set rng2 = Nothing
        Else
            msg = "Header: " & rng1 & " not found or is hidden. Continue with next header [(Yes) or stop macro (No)]?"
            If MsgBox(msg, vbYesNo, "Header not found") = vbNo Then End
        End If
    
    Next rng1
        
    Application.ScreenUpdating = True
        
Set wks1 = Nothing: Set wks2 = Nothing
        
End Sub
 
Upvote 0
After clicking through all of the message boxes, it pasted only the Customer # (no other columns). :(
 
Upvote 0
Without seeing your spreadsheet, I'm not sure what else to suggest. I created two worksheets, one with headers A, B, C, D, E, F and the other with random headers, such as D, E, B or A, H, C and it pulled in the correct data from the first sheet with headers A, B, C, D, E, F where the column headers matched (without any message boxes).
 
Upvote 0
Jack - Here's a visualization that I hope helps.

Tab.1. - Customer# begins in Column A, row 1.

Customer #NameAgeSchoolCity

<tbody>
</tbody>



Tab.2. - Customer# begins in Column A, row 15.

Customer #Customer CodeMr/Mrs/MsNameAgeSchoolSchool ZoneZip CodeCityState
1870MrJonathan40Boston00990XXXXXBostonMass.
2239MsLeslie30Tokyo33010XXXXXTokyoX
3230MrsJohanna48Prague02323XXXXXPragueX
4463MrLucas23Baltimore11409XXXXXBaltimoreMD

<tbody>
</tbody>


What I want to do is arrange the original Copy Range code that I wrote in VB, and alter it so that it will only pull in information from the column headers I have specified. Preferably, the order of the columns doesn't matter, but I'm not sure how to integrate that as well. Your code wasn't working out for me earlier - I'm worried it is because of the differences in the rows between the two sheets.

The goal would be that I would run the code, and the information from Tab.2. would come into Tab.1. just for those column headers, and no extraneous or incorrect data would come in.

Thank you so much for all of your help!!
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,207
Members
448,554
Latest member
Gleisner2

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