• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to copy 3 columns from one excel document to another excel document already created

Hello all,

This the help I require, please help

Ex:
1 - I have 2 excel documents, 1 is called DOC1 and the other is called DOC2 . Both of them are located in the same folder D:\\Data\......
2 - In the DOC1 document one of the sheets is called INFO, and from that sheet I need to copy 2 columns out of a few and copy them in to the document called DOC2 in a new sheet.
3 - also the DOC1 document it has another sheet call BASIC, and I need to copy one column from there to the DOC2 document where the other 2 columns were copied in a new sheet.

Please sorry if it hard to understand, not a savvy in VBA.

Please help

thanks in advance
 
Open Doc1 then run

Code:
Sub DocCopy()

Dim Doc1Name As String
Dim Doc2Name As String
Dim Doc2Sheet As String
Dim Doc2Path As String

Doc1Name = ActiveWorkbook.Name
Doc2Path = ActiveWorkbook.Path & "\Doc2.xlsx"

'Check if user is in Doc1
'------------------------
If ActiveWorkbook.Name = "DOC1.xlsx" Then

  'Open Doc2
  Workbooks.Open Filename:=Doc2Path, ReadOnly:=False
  Doc2Name = ActiveWorkbook.Name

  'Copy Columns from Doc1 to Doc2 in new sheet

  Windows(Doc1Name).Activate
  Worksheets("INFO").Select
  Columns("A:B").Copy 'change to whichever columns you want to copy
  Windows(Doc2Name).Activate
  Worksheets.Add After:=Worksheets(Worksheets.Count)
  Doc2Sheet = ActiveSheet.Name
  Range("A1").Select
  ActiveSheet.Paste

  Windows(Doc1Name).Activate
  Worksheets("BASIC").Select
  Columns("C:C").Copy 'change to whichever columns you want to copy
  Windows(Doc2Name).Activate
  Worksheets(Doc2Sheet).Select
  Range("C1").Select
  ActiveSheet.Paste

  Workbooks(Doc2Name).Close savechanges:=True
  Windows(Doc1Name).Activate

  MsgBox "Doc1 data copied to Doc2", vbInformation, ""

Else
  MsgBox "Open 'Doc1.xlsx' file before running the macro", vbCritical, ""
End If


End Sub
 
Last edited:
Thanks for the response Chirayu.

1 - I pasted the code in to the Doc1 that I saved it with this extension xlsm
and when I run the macro I received these messages

Open Doc1.xlsx file before running macro or
Run-time erros'1004 application-defined or object-defined error

2 - On the line that required the path for Doc2 I put the location

3 - Also I keep receiving the message
" Privacy Warning:this document contains macros,ActiveX controls,XML expansion pack information or web components. these may include personal information that cannot be removed by the document Inspector."

Please help, I pasted the code
Code:
Sub DocCopy()

Application.DisplayAlerts = False
  ActiveWorkbook.Save
Application.DisplayAlerts = True

Dim Doc1Name As String
Dim Doc2Name As String
Dim Doc2Sheet As String
Dim Doc2Path As String

Doc1Name = ActiveWorkbook.Name
Doc2Path = ActiveWorkbook.Path & "D:\Test TSM\Doc2.xlsx"

'Check if user is in Doc1
'------------------------
If ActiveWorkbook.Name = "Doc1.xlsm" Then

  'Open Doc2
Workbooks.Open Filename:=Doc2Path, ReadOnly:=False
  Doc2Name = ActiveWorkbook.Name

  'Copy Columns from Doc1 to Doc2 in new sheet

  Windows(Doc1Name).Activate
  Worksheets("INFO").Select
  Columns("A:B").Copy 'change to whichever columns you want to copy
Windows(Doc2Name).Activate
  Worksheets.Add After:=Worksheets(Worksheets.Count)
  Doc2Sheet = ActiveSheet.Name
  Range("A1").Select
  ActiveSheet.Paste

  Windows(Doc1Name).Activate
  Worksheets("BASIC").Select
  Columns("C:C").Copy 'change to whichever columns you want to copy
Windows(Doc2Name).Activate
  Worksheets(Doc2Sheet).Select
  Range("C1").Select
  ActiveSheet.Paste

  Workbooks(Doc2Name).Close savechanges:=True
  Windows(Doc1Name).Activate

  MsgBox "Doc1 data copied to Doc2", vbInformation, ""

Else
  MsgBox "Open 'Doc1.xlsx' file before running the macro", vbCritical, ""
End If


End Sub
 
1) Are Doc1 & Doc2 in the same folder or different folder?

The ActiveWorkbook.Path takes the location for Doc1 & then uses it in conjunction to open Doc2 which is placed in same location:
Code:
Doc2Path = ActiveWorkbook.Path & "\Doc2.xlsx"

Your altered code throws up an error because its taking the path for Doc1 but adding on the entire path for Doc2. Remove Activeworkbook.Path if you want to use a direct file location:
Code:
Doc2Path = "D:\Test TSM\Doc2.xlsx"

2) Refer to above point

3) That is most likely to do with your setting in that Excel file (Doc1 or Doc2).

For excel 2007 process I below to fix

a) Click on Windows Icon (Top left in Excel)
b) Click on Excel options (Bottom right in the Popup Menu)
c) Click on Trust Centre tab (Left hand side in popup)
d) Click on Trust Centre Settings (Right hand side of popup)
e) Click on Privacy options (left hand side of popup)
f) Untick "Remove personal information from file properties on save" option & click ok
 
Hi chirayu

I left it as you said, As both documents are in the same folder i used

Code:
Doc2Path = ActiveWorkbook.Path & "\Doc2.xlsx"

and I changed the columns to be copied from sheet INFO to B and C
and the column to be copied from sheet BASIC to H

When I run the macro in Doc1.xlsm I received the error message

Run-time error '9' Subscript out of range

Please see the complete code. all these 3 columns needs to be pasted in Doc2.xlsx in a new sheet

Code:
Sub DocCopy()

Dim Doc1Name As String
Dim Doc2Name As String
Dim Doc2Sheet As String
Dim Doc2Path As String

Doc1Name = ActiveWorkbook.Name
Doc2Path = ActiveWorkbook.Path & "\Doc2.xlsx"

'Check if user is in Doc1
'------------------------
If ActiveWorkbook.Name = "Doc1.xlsm" Then

  'Open Doc2
Workbooks.Open Filename:=Doc2Path, ReadOnly:=False
  Doc2Name = ActiveWorkbook.Name

  'Copy Columns from Doc1 to Doc2 in new sheet

  Windows(Doc1Name).Activate
  Worksheets("INFO").Select
  Columns("B:C").Copy 'change to whichever columns you want to copy
Windows(Doc2Name).Activate
  Worksheets.Add After:=Worksheets(Worksheets.Count)
  Doc2Sheet = ActiveSheet.Name
  Range("A1").Select
  ActiveSheet.Paste

  Windows(Doc1Name).Activate
  Worksheets("BASIC").Select
  Columns("H:H").Copy 'change to whichever columns you want to copy
Windows(Doc2Name).Activate
  Worksheets(Doc2Sheet).Select
  Range("C1").Select
  ActiveSheet.Paste

  Workbooks(Doc2Name).Close savechanges:=True
  Windows(Doc1Name).Activate

  MsgBox "Doc1 data copied to Doc2", vbInformation, ""

Else
  MsgBox "Open 'Doc1.xlsx' file before running the macro", vbCritical, ""
End If

End Sub

Thanks
 
Hello Chirayu,

I attached my 2 documents. I receive the error, open Doc1.xlsx file before running the macro. even with this doc open I receive this error.

Please let me know
 

Attachments

  • Doc1.xlsm
    14.2 KB · Views: 0
  • Doc2.xlsx
    7.2 KB · Views: 0
Found the issue. It was partially your files & partially the macro code. So I pasted the original macro & created new sample files and edited macro to match the changes you made. Working fine now.
 

Attachments

  • Doc1.xlsm
    16.1 KB · Views: 0
  • Doc2.xlsx
    6.8 KB · Views: 0
Hi Chirayu,

Thank you so much, it really copy the columns to Doc2 in a new sheet, but for some reason it doesn't copy the columns in columns A,B &C. how can this be done? I would like this 3 columns one next to the other.

right now it is being copied in columns A,C & G

Thank you
 
That's odd because the code copies E & K from Info sheet & F from Basic sheet from Doc1 & pastes in column A B C in Doc2.

Change the column names/ ranges to whatever suits you.
 
No idea why this is happening, I attached the 2 files.

Could you please check Doc 2 for you to see the way the columns are being tranfered? Could you please check code in Doc1 in case I'm missing something?
 

Attachments

  • Doc1.xlsm
    16.9 KB · Views: 0
  • Doc2.xlsx
    8.4 KB · Views: 0
Figured it out. Its cos I was using the range from your old post rather than treating each column as separate.
 

Attachments

  • Doc1.xlsm
    16.5 KB · Views: 0
Back
Top