VBA Copy COLs "B", "E" and "N" into the other open Excel file - into "AB", "AC" and "AD"

C

ChrisOK

Well-known Member
Joined
Mar 26, 2003
Messages
601
Tying code to a quick toolbar button to expedite a repetitive task of always copying the same columns from an export file into my main parts data file as follows:

Starting w/ ROW 3 in filename: "exportParts.xls" (it will ALWAYS be this file name)
Select B3 down until end of data and PASTE into the other open Excel file and PASTE starting at AB5 down
Select E3 down until end of data and PASTE into the other open Excel file and PASTE starting at AC5 down
Select N3 down until end of data and PASTE into the other open Excel file and PASTE starting at AD5 down

The other file (that it will paste in to) will have various names so I will make sure that ONLY those 2 Excel files are open to keep the code from pasting into an unwanted other file. (keeping in mind to exclude the Personal file which is always open) thus pasting into the 3rd Excel file available/open.

Help greatly appreciated!
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
Assuming I understand correctly, here is how I would do it (always remember to backup your work, this code is untested, but should at least give you a starting point):
Code: 
    ' -----------------------------------------------------------------------------------------
    ' Define variables
    ' -----------------------------------------------------------------------------------------
    Dim strFilename As String
    Dim strWorkbookName As String
    Dim objInputWB As Workbook
    Dim objExtractWB As Workbook
    Dim oWB As Workbook
    Dim lngLastRow As Long
    
    ' -----------------------------------------------------------------------------------------
    ' Get the name of the file to extract data to
    ' -----------------------------------------------------------------------------------------
    strFilename = Application.GetOpenFilename(FileFilter:="Microsoft Excel, *.xls*", _
                                              FilterIndex:=1, _
                                              Title:="Select file to extract to:", _
                                              MultiSelect:=False)
    
    ' -----------------------------------------------------------------------------------------
    ' Ensure we haven't selected an invalid filename
    ' -----------------------------------------------------------------------------------------
    If strFilename = "False" Then Exit Sub ' We hit cancel
    
    ' -----------------------------------------------------------------------------------------
    ' Check to see if it is already open
    ' -----------------------------------------------------------------------------------------
    strWorkbookName = VBA.Strings.Right(strFilename, VBA.Strings.Len(strFilename) - _
                      VBA.Strings.InStrRev(strFilename, Application.PathSeparator))
    If strFilename = ThisWorkbook.Name Then ' We selected this workbook
        MsgBox Prompt:="Invalid selection detected, cancelling data Extraction!", _
               Buttons:=vbCritical, _
               Title:="Data Extraction Error"
        Exit Sub
    End If
    For Each oWB In Workbooks
        If oWB.Name = strWorkbookName Then
            Set objInputWB = oWB
            Exit For
        End If
    Next oWB
    Set oWB = Nothing
    
    ' -----------------------------------------------------------------------------------------
    ' If not already open, open it.
    ' -----------------------------------------------------------------------------------------
    If objInputWB Is Nothing Then Set objInputWB = Workbooks.Open(Filename:=strFilename)
    
    ' -----------------------------------------------------------------------------------------
    ' Determine if our extract workbook (exportParts.xls) is open
    ' -----------------------------------------------------------------------------------------
    For Each oWB In Workbooks
        If oWB.Name = "exportParts.xls" Then
            Set objExtractWB = oWB
            Exit For
        End If
    Next oWB
    Set oWB = Nothing
    
    ' -----------------------------------------------------------------------------------------
    ' If we don't find our extract workbook open, open it.
    ' -----------------------------------------------------------------------------------------
    If objExtractWB Is Nothing Then
        
        ' -------------------------------------------------------------------------------------
        ' Determine where the file is located and open.
        ' -------------------------------------------------------------------------------------
        strFilename = Application.GetOpenFilename(FileFilter:="Microsoft Excel, exportParts.xls", _
                                                  FilterIndex:=1, _
                                                  Title:="Select extract file:", _
                                                  MultiSelect:=False)
        If strFilename = "False" Then Exit Sub
        strWorkbookName = VBA.Strings.Right(strFilename, VBA.Strings.Len(strFilename) - _
                          VBA.Strings.InStrRev(strFilename, Application.PathSeparator))
            If strFilename = ThisWorkbook.Name Then ' We selected this workbook
                MsgBox Prompt:="Invalid selection detected, cancelling data Extraction!", _
                       Buttons:=vbCritical, _
                       Title:="Data Extraction Error"
                objInputWB.Close SaveChanges:=False
            Exit Sub
        End If
        Set objExtractWB = Workbooks.Open(Filename:=strFilename)
    End If
    
    ' -----------------------------------------------------------------------------------------
    ' SPECIAL NOTE: For our purposes we are assuming that the data is going from and to
    ' Sheets(1) of each WB
    ' -----------------------------------------------------------------------------------------
    
    With objExtractWB.Sheets(1)
                
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("B" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        
        ' --------------------------------------------------------------------------------------
        ' Transfer column B to AB of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("B3:B" & lngLastRow).Copy
        objInputWB.Sheets(1).Range("AB5").PasteSpecial
        
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("E" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        
        ' --------------------------------------------------------------------------------------
        ' Transfer column E to AC of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("E3:E" & lngLastRow).Copy
        objInputWB.Sheets(1).Range("AC5").PasteSpecial
        
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("N" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        
        ' --------------------------------------------------------------------------------------
        ' Transfer column B to AB of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("N3:N" & lngLastRow).Copy
        objInputWB.Sheets(1).Range("AD5").PasteSpecial
    End With
    
    MsgBox "Transfer Complete!"
Hope that helps!
 
Upvote 0
I created a new module in the Personal.xls area, pasted it in there between a Sub Copy_Paste_Export() and End Sub but when I go to run it, it prompts me to save? What am I doing wrong?
 
Upvote 0
Ok, disregard the Save... it was actually prompting to locate/open the Recipient file - but don't want that... because the user will always already have it open
and I don't want them to stop their work, have to shut down the file, just to have to reopen it using that prompt.

<u>Here's the 2 issues I encounted / but one has been corrected:</u>
<b>1st</b> - It was apparently pasting to Sheet 1 (and I needed it pasting to 2, so I adjusted it and it successfully copy/pasted!) "<b><i>HAPPY DANCE</b></i>
<b>2nd</b> - All of the code relating to opening the first workbook is not needed because the analyst will always have the necessary files open (due to extensive pre-work that takes place prior to them getting to this step)
<b>**</b>Tried to "comment out" the parts that I thought might by-pass that functionality but it's causing a break --
<b>**</b>Can you comment out (appropriately) the parts that will turn off that functionality?

<b>*</b><u>HERE'S HOW THE PROCESS WORKS:<b>*</b></u>
1. Analyst opens their working file and has been doing a lot of work to it..
2. They jump over to a main frame system on their other screen and generate an output which automatically opens on their screen as a 2nd "ExportParts.xls" file.
3. Now, they are sitting there with their main file ALREADY OPEN and the 2nd file (which is the Export file) and BOTH ARE ALREADY READY to simply highlight/paste from one to the other.
4. I have created a quick-quick icon on the analyst's toolbar to be able to simply hit that button (which runs the copy/paste code) from the one file to the other file.
* These are the only 2 files that will be open within Excel at that point in time (well, the Personal.xls may be open and hidden in the background as a 3rd file)..

<b><u>If you'd like to customize it "to be safe"... here's a way you can be sure the code it taking it from the right file and pasting INTO the right file....</b></u>
The <b>SOURCE</b> file will be the "ExportParts.xls"
The <b>RECIPIENT</b> file will have various names <u><b>but will ALWAYS HAVE SHEET 2 called: "SSParts Worksheet"</u></b>
(this unique fact could be used in your code to make sure the ExportParts.xls is always going to PASTE INTO the correct sheet <u><b>IF IT SEES an excel file WITH A "Sheet 2" called: "SSParts Worksheet"</u></b>

Hope that makes sense! =-)
 
Last edited:
Upvote 0
This Should do what you want it to, it finds the two workbooks and extracts without prompting the user for any information, though it doesn't allow them to correct it if it isn't open already.
Code: 
    ' -----------------------------------------------------------------------------------------
    ' Define variables
    ' -----------------------------------------------------------------------------------------
    Dim strFilename As String
    Dim strWorkbookName As String
    Dim objInputWB As Workbook
    Dim objExtractWB As Workbook
    Dim oWB As Workbook, oWS As Worksheet
    Dim lngLastRow As Long, bFound As Boolean
    ' -----------------------------------------------------------------------------------------
    ' Find workbook with Worksheet named SSParts Worksheet
    ' -----------------------------------------------------------------------------------------
    For Each oWB In Workbooks
        For Each oWS In oWB.Sheets
            If oWS.Name = "SSParts Worksheet" Then
                Set objInputWB = oWB
                bFound = True
            End If
            If bFound Then Exit For
        Next oWS
        If bFound Then Exit For
    Next oWB
    Set oWB = Nothing
    ' -----------------------------------------------------------------------------------------
    ' Advise user and terminate program if we cannot find the approprate workbook.
    ' -----------------------------------------------------------------------------------------
    If Not bFound Then
        MsgBox Prompt:="Unable to find data's destination, terminating transfer!", _
               Buttons:=vbCrtical, _
               Title:="Export"
        Exit Sub
    End If
    ' -----------------------------------------------------------------------------------------
    ' Determine if our extract workbook (exportParts.xls) is open
    ' -----------------------------------------------------------------------------------------
    For Each oWB In Workbooks
        If oWB.Name = "exportParts.xls" Then
            Set objExtractWB = oWB
            Exit For
        End If
    Next oWB
    Set oWB = Nothing
    ' -----------------------------------------------------------------------------------------
    ' If we don't find our extract workbook open
    ' -----------------------------------------------------------------------------------------
    If objExtractWB Is Nothing Then
        MsgBox Prompt:="Invalid selection detected, cancelling data Extraction!", _
               Buttons:=vbCritical, _
               Title:="Export"
        Exit Sub
    End If
    ' -----------------------------------------------------------------------------------------
    ' SPECIAL NOTE: For our purposes we are assuming that the data is going from and to
    ' Sheets(1) of each WB
    ' -----------------------------------------------------------------------------------------
    If Not oWS.Name = "SSParts Worksheet" Then
        For Each oWS In oInputWB.Sheets
            If oWS.Name = "SSParts Worksheet" Then
                Exit For
            End If
        Next oWS
    End If
    With objExtractWB.Sheets(1)
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("B" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        ' --------------------------------------------------------------------------------------
        ' Transfer column B to AB of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("B3:B" & lngLastRow).Copy
        oWS.Range("AB5").PasteSpecial
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("E" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        ' --------------------------------------------------------------------------------------
        ' Transfer column E to AC of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("E3:E" & lngLastRow).Copy
        oWS.Range("AC5").PasteSpecial
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("N" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        ' --------------------------------------------------------------------------------------
        ' Transfer column B to AB of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("N3:N" & lngLastRow).Copy
        oWS.Range("AD5").PasteSpecial
    End With
    MsgBox "Transfer Complete!"
Just as an FYI, I think there was some confusion with the dialog box, it only provided the program with a file name, it never shut the file down. Just searched for it and if not found opened it. But hopefully this will do the track, good luck!
 
Upvote 0
Hello Rosen (Or anyone that may be of help in Rosen's absence)! I tried running it but it did not work ---
I noticed that you stated <i>"assuming both sheets are "Sheet1"</i> however, that's not the case, which may be our issue... Below is a clip of code referring to that...
<b>**</b>Anyhow, the ExportParts.xls (SOURCE) FILE <u>is using SHEET1</u> <b>however,</b> the RECIPENT FILE that will always have a tab/sheet called: <b>"SS Parts Worksheet"</b> <u>is always going to be SHEET2</u>.

I'm not sure how to adjust this to make it work...? Assistance much appreciated!

Rosen said:
This Should do what you want it to, it finds the two workbooks and extracts without prompting the user for any information, though it doesn't allow them to correct it if it isn't open already.
Code: 
    ' -----------------------------------------------------------------------------------------
    ' Define variables
    ' -----------------------------------------------------------------------------------------
    Dim strFilename As String
    Dim strWorkbookName As String
    Dim objInputWB As Workbook
    Dim objExtractWB As Workbook
    Dim oWB As Workbook, oWS As Worksheet
    Dim lngLastRow As Long, bFound As Boolean
    ' -----------------------------------------------------------------------------------------
    ' Find workbook with Worksheet named SSParts Worksheet
    ' -----------------------------------------------------------------------------------------
    For Each oWB In Workbooks
        For Each oWS In oWB.Sheets
            If oWS.Name = "SSParts Worksheet" Then
                Set objInputWB = oWB
                bFound = True
            End If
            If bFound Then Exit For
        Next oWS
        If bFound Then Exit For
    Next oWB
    Set oWB = Nothing
    ' -----------------------------------------------------------------------------------------
    ' Advise user and terminate program if we cannot find the approprate workbook.
    ' -----------------------------------------------------------------------------------------
    If Not bFound Then
        MsgBox Prompt:="Unable to find data's destination, terminating transfer!", _
               Buttons:=vbCrtical, _
               Title:="Export"
        Exit Sub
    End If
    ' -----------------------------------------------------------------------------------------
    ' Determine if our extract workbook (exportParts.xls) is open
    ' -----------------------------------------------------------------------------------------
    For Each oWB In Workbooks
        If oWB.Name = "exportParts.xls" Then
            Set objExtractWB = oWB
            Exit For
        End If
    Next oWB
    Set oWB = Nothing
    ' -----------------------------------------------------------------------------------------
    ' If we don't find our extract workbook open
    ' -----------------------------------------------------------------------------------------
    If objExtractWB Is Nothing Then
        MsgBox Prompt:="Invalid selection detected, cancelling data Extraction!", _
               Buttons:=vbCritical, _
               Title:="Export"
        Exit Sub
    End If
    ' -----------------------------------------------------------------------------------------
    ' SPECIAL NOTE: For our purposes we are assuming that the data is going from and to
    ' Sheets(1) of each WB
    ' -----------------------------------------------------------------------------------------
    If Not oWS.Name = "SSParts Worksheet" Then
        For Each oWS In oInputWB.Sheets
            If oWS.Name = "SSParts Worksheet" Then
                Exit For
            End If
        Next oWS
    End If
    With objExtractWB.Sheets(1)
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("B" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        ' --------------------------------------------------------------------------------------
        ' Transfer column B to AB of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("B3:B" & lngLastRow).Copy
        oWS.Range("AB5").PasteSpecial
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("E" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        ' --------------------------------------------------------------------------------------
        ' Transfer column E to AC of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("E3:E" & lngLastRow).Copy
        oWS.Range("AC5").PasteSpecial
        ' --------------------------------------------------------------------------------------
        ' Determine last line of column B
        ' --------------------------------------------------------------------------------------
        lngLastRow = 3
        Do Until .Range("N" & lngLastRow).Value = vbNullString
            lngLastRow = lngLastRow + 1
        Loop
        lngLastRow = lngLastRow - 1
        ' --------------------------------------------------------------------------------------
        ' Transfer column B to AB of objInputWB
        ' --------------------------------------------------------------------------------------
        .Range("N3:N" & lngLastRow).Copy
        oWS.Range("AD5").PasteSpecial
    End With
    MsgBox "Transfer Complete!"
Just as an FYI, I think there was some confusion with the dialog box, it only provided the program with a file name, it never shut the file down. Just searched for it and if not found opened it. But hopefully this will do the track, good luck!
Click to expand...
 
Upvote 0
Sorry, I never removed the comment, we are not assuming sheet one, we are looking for a worksheet with a tab called "SSParts Worksheet", though if it is "SS Parts Worksheet" you'll need to change the line

If oWS.Name = "SSParts Worksheet" Then

To

If oWS.Name = "SS Parts Worksheet" Then

Are you getting the message "Unable to find data's destination, terminating transfer!" when you ran it? What did happen, if anything?
 
Upvote 0
This is what's wrong:
When I ran the code, it is copying data from the SOURCE file "ExportParts.xls" Column B into itself (the same SOURCE file Column AB) but it should be copying from "ExportParts.xls" and pasting into the RECIPIENT file's tab called "SSParts Worksheet" Column AB...

Since the recipient file will always have different file names, we don't refer to that, but instead, we look to the sheet we KNOW WILL ALWAYS BE PRESENT within the RECIPIENT file called: "SSParts Worksheet"..

Transfer Table
SOURCE...........COLUMN LOCATION............................RECIPIENT FILE.................WITH THIS SHEET NAME in Recipient file....Column Location
"ExportParts.xls"....COL B should paste into the other open workbook's sheet identified as "SSParts Worksheet" Column AB
"ExportParts.xls"....COL E should paste into the other open workbook's sheet identified as "SSParts Worksheet" Column AC
"ExportParts.xls"....COL N should paste into the other open workbook's sheet identified as "SSParts Worksheet" Column AD
 
Upvote 0
Does ExportParts.xls have a worksheet called "SSParts Worksheet"?
 
Upvote 0
No, the ExportParts.xls DOES NOT have a worksheet called "SSParts Worksheet"?

THE 'KNOWNS':
1- we will always have 2 Excel files open at once:
...SOURCE FILE: will always be named: "ExportParts.xls" and only has one sheet called: "Supportability"
...RECIPIENT FILE: will have different names BUT WILL ALWAYS HAVE A SHEET 2 within that file called: "SSParts Worksheet"
...........................(this SSParts (recipient) sheet is where the source should paste the data into...)

CODE SHOULD:
In "ExportParts.xls" FILE, sheet1 called: "Supportability"
....Copy B3 down (until the end of data) and paste into other open RECIPIENT file w/ sheet called "SSParts Worksheet" AB5 down
....Copy E3 down (until the end of data) and paste into other open RECIPIENT file w/ sheet called "SSParts Worksheet" AC5 down
....Copy N3 down (until the end of data) and paste into other open RECIPIENT file w/ sheet called "SSParts Worksheet" AD5 down
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Extracting data with VBA macro button from files in designated folder
2 3
Replies
20
Views
709
Micron
M
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
P
  • Question Question
Locate certain file in the download folder and then copy and paste content to another worksheet in another workbook
Replies
1
Views
215
Micron
M
B
  • Question Question
VBA exports worksheet from XLSM to XLXS matching all source properties doesn't keep print area
Replies
0
Views
80
brentcole
B
P
  • Solved
VBA to open file using Cell for the path
Replies
4
Views
1K
Peter Davison
P

Forum statistics

Threads
1,223,230
Messages
6,170,883
Members
452,364
Latest member
springate

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