I need macro to open a file, copy and paste everything under specific column into workbook

[kbenjamin827]

Hi all,

I need a macro that opens a file, then copy and pastes everything under a specific column (named Total) and place those values under the Total column in the workbook. What I have so far is a macro that opens a file, and copies and pastes values from a fixed cell range, into a fixed destination.

Sub Foo()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet

Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet


    '-------------------------------------------------------------
    'Open file with data to be copied
    
    vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
    "*.xl*", 1, "Select Excel File", "Open", False)
    
    'If Cancel then Exit
    If TypeName(vFile) = "Boolean" Then
        Exit Sub
    Else
    Set wbCopyFrom = Workbooks.Open(vFile)
    Set wsCopyFrom = wbCopyFrom.Worksheets(1)
    End If
    
    '--------------------------------------------------------------
    'Copy Range
    wsCopyFrom.Range("D6:R26").Copy
    wsCopyTo.Range("D7").PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    wsCopyFrom.Range("S6:S26").Copy
    wsCopyTo.Range("X7").PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            
    'Close file that was opened
    wbCopyFrom.Close SaveChanges:=False

End Sub

Any suggestions?

 

[Fluff]

Which columns are the Total in?

 

[kbenjamin827]

The workbook that I am trying to paste the information into is column X. The file that I am opening to copy from varies.

 

[Fluff]

Ok try this

    'Copy Range
    With wsCopyFrom
      Set Fnd = .Range("5:5").Find("Total", , , xlWhole, , , False, , False)
      If Not Fnd Is Nothing Then
         .Range(Fnd.Offset(1), .Cells(.Rows.Count, Fnd.Column).End(xlUp)).Copy
      End If
    End With
    wsCopyTo.Range("X7").PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False

I've assumed that the word "Total" is in row 5

 

[Fluff]

Cross posted https://www.excelforum.com/excel-pr...hing-under-specific-column-into-workbook.html

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

 

[kbenjamin827]

Thank you so much! that worked out beautifully. My apologies for breaking one of the rules.

 

[kbenjamin827]

If I wanted to do this with multiple columns, would I just copy and paste this code and change the "Total" to something else, as well as the range from "X7" to something else?

 

[Fluff]

Yes that's one way of doing it. How many columns will you be looking to copy?

 

[kbenjamin827]

15:/ the columns are number 1-15 and then the total column. The issue im facing now is sometimes when I run the program and I am given the option to open the file, that file I open will only have columns 3-9, or 2-10, basically it varies. Whats happening now is values from other columns are being placed into columns that should be empty or "0".

 

[Fluff]

Try

Sub Foo()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet
Dim Fnd As Range
Dim Ary As Variant
Dim i As Long

Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet
Ary = Array("[COLOR=#ff0000]Total[/COLOR]", [COLOR=#0000ff]24[/COLOR], "[COLOR=#ff0000]District[/COLOR]", [COLOR=#0000ff]1[/COLOR], "[COLOR=#ff0000]Northing[/COLOR]",[COLOR=#0000ff] 2[/COLOR])

    '-------------------------------------------------------------
    'Open file with data to be copied
    
    vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
    "*.xl*", 1, "Select Excel File", "Open", False)
    
    'If Cancel then Exit
    If TypeName(vFile) = "Boolean" Then
        Exit Sub
    Else
    Set wbCopyFrom = Workbooks.Open(vFile)
    Set wsCopyFrom = wbCopyFrom.Worksheets(1)
    End If
    
    '--------------------------------------------------------------
 'Copy Range
   For i = 0 To UBound(Ary) Step 2
      Set Fnd = wsCopyFrom.Range("5:5").Find(Ary(i), , , xlWhole, , , False, , False)
      If Not Fnd Is Nothing Then
         wsCopyFrom.Range(Fnd.Offset(1), wsCopyFrom.Cells(wsCopyFrom.Rows.Count, Fnd.Column).End(xlUp)).Copy
         wsCopyTo.Cells(7, Ary(i + 1)).PasteSpecial xlPasteValues
      End If
   Next i
   Application.CutCopyMode = False
   wbCopyFrom.Close SaveChanges:=False

End Sub

Where the values in red are the column headers & the value in blue is the column number they should be pasted to