Need macro for copying some Columns from another workbook

[gamerosko]

Hi,

as far as I am no VBA knowledged, I would appreciate help, if anybody could write me code for copying certain columns from another workbook into currently opened workbook.
---
USER

<TABLE style="PADDING-RIGHT: 2pt; PADDING-LEFT: 2pt; FONT-SIZE: 11pt; FONT-FAMILY: Calibri,Arial; BACKGROUND-COLOR: #ffffff" cellSpacing=0 cellPadding=0 border=1><COLGROUP><COL style="FONT-WEIGHT: bold; WIDTH: 30px"><COL style="WIDTH: 113px"><COL style="WIDTH: 86px"><COL style="WIDTH: 101px"><COL style="WIDTH: 78px"><COL style="WIDTH: 81px"><COL style="WIDTH: 72px"><COL style="WIDTH: 79px"><COL style="WIDTH: 64px"></COLGROUP><TBODY><TR style="FONT-WEIGHT: bold; FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center"><TD> </TD><TD>A</TD><TD>B</TD><TD>C</TD><TD>D</TD><TD>E</TD><TD>F</TD><TD>G</TD><TD>H</TD></TR><TR style="HEIGHT: 19px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">1</TD><TD>File name:</TD><TD>'F:\LCCC Sales\Sales\REPORTS\2010\2010_05\Basics\[USB-05-2010-Basic-YTD-consolidated.xlsx]data'!</TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD><TD> </TD></TR><TR style="HEIGHT: 19px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">2</TD><TD>Currency:</TD><TD style="TEXT-ALIGN: right">2</TD><TD style="BACKGROUND-COLOR: #ffff00; TEXT-ALIGN: center">USB</TD><TD> </TD><TD>Columns positions:</TD><TD> </TD><TD> </TD><TD> </TD></TR><TR style="HEIGHT: 19px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">3</TD><TD>Year:</TD><TD style="TEXT-ALIGN: right">3</TD><TD style="BACKGROUND-COLOR: #ffff00; TEXT-ALIGN: center">2010</TD><TD> </TD><TD style="FONT-WEIGHT: bold">Product</TD><TD>$AO:$AO</TD><TD style="FONT-WEIGHT: bold">Totchg</TD><TD>$S:$S</TD></TR><TR style="HEIGHT: 19px"><TD style="FONT-SIZE: 8pt; BACKGROUND-COLOR: #cacaca; TEXT-ALIGN: center">4</TD><TD>Month</TD><TD style="TEXT-ALIGN: right">5</TD><TD style="BACKGROUND-COLOR: #ffff00; TEXT-ALIGN: center">05</TD><TD> </TD><TD style="FONT-WEIGHT: bold">BT Provider</TD><TD>$BB:$BB</TD><TD style="FONT-WEIGHT: bold">Totair</TD><TD>$Y:$Y</TD></TR></TBODY></TABLE>
<TABLE style="FONT-SIZE: 10pt; BORDER-LEFT-COLOR: #00ff00; BORDER-BOTTOM-COLOR: #00ff00; COLOR: #000000; BORDER-TOP-STYLE: groove; BORDER-TOP-COLOR: #00ff00; FONT-FAMILY: Arial; BORDER-RIGHT-STYLE: groove; BORDER-LEFT-STYLE: groove; BACKGROUND-COLOR: #fffcf9; BORDER-RIGHT-COLOR: #00ff00; BORDER-BOTTOM-STYLE: groove"><TBODY><TR><TD>Spreadsheet Formulas</TD></TR><TR><TD><TABLE style="FONT-SIZE: 9pt; FONT-FAMILY: Arial" cellSpacing=0 cellPadding=2 border=1><TBODY><TR style="FONT-SIZE: 10pt; BACKGROUND-COLOR: #cacaca"><TD>Cell</TD><TD>Formula</TD></TR><TR><TD>B1</TD><TD>="'F:\LCCC Sales\Sales\REPORTS\"&C3&"\"&C3&"_"&C4&"\Basics\["&C2&"-"&C4&"-"&C3&"-Basic-YTD-consolidated.xlsx]data'!"</TD></TR><TR><TD>C2</TD><TD>=VLOOKUP($B2;control_tables!$A$1:$D$13;2;FALSE)</TD></TR><TR><TD>C3</TD><TD>=VLOOKUP($B3;control_tables!$A$1:$D$13;3;FALSE)</TD></TR><TR><TD>F3</TD><TD>=IF(C3>2009;"$AO:$AO";"$AN:$AN")</TD></TR><TR><TD>H3</TD><TD>="$S:$S"</TD></TR><TR><TD>C4</TD><TD>=VLOOKUP($B4;control_tables!$A$1:$D$13;4;FALSE)</TD></TR><TR><TD>F4</TD><TD>=IF(C3>2009;"$BB:$BB";"$AZ:$AZ")</TD></TR><TR><TD>H4</TD><TD>="$Y:$Y"</TD></TR></TBODY></TABLE></TD></TR></TBODY></TABLE>

Excel tables to the web >> http://www.excel-jeanie-html.de/index.php?f=1" target="_blank"> Excel Jeanie HTML 4

1) in B1 you can see "incomplete" path to the file from I will need to perform the copy
(use only value, as far as it chages due to users dropdown menus selection)

2) in F3,F4,H3,H4 there are the rest of paths for columns I will need to copy, so B1&F3 or B1&F4 etc.. gives full path for the file, sheet and columns i need to copy

3) these 4 columns should be copied (i dont care about columns order) into the file, that user has opened and will perform the macro through button.
File name is test.xlsx ; Sheet only visible to user is called "USER" - here will be the macro button ; Sheet (already exists and is hidden) where to copy these 4 columns is named data

PS: I would need this to work without any further action performed by user.. means the file from you copy columns is closed. (you can open it, hide actions, but then auto close it).

Thx much for help,
gamerosko.

 

[al_b_cnu]

Hi,

Try this macro:

Option Explicit
Const msSourcefileCell As String = "USER!B1"
Const msCopycolumns As String = "F3,F4,H3,H4"
Sub CopyData()
Dim iCol As Integer
Dim lTargetEnd As Long
Dim rCur As Range
Dim sColumns As String
Dim saSourcefileCell() As String
Dim saSourcefile() As String
Dim wbSource As Workbook
Dim wsInfo As Worksheet, wsSource As Worksheet, wsTarget As Worksheet

saSourcefileCell = Split(msSourcefileCell, "!")
Set wsInfo = Sheets(saSourcefileCell(0))
Set wsTarget = Sheets("Data")

saSourcefile = Split(CStr(wsInfo.Range(saSourcefileCell(1)).Value), "]")
saSourcefile(0) = Replace(saSourcefile(0), "[", "")
saSourcefile(1) = Replace(Replace(saSourcefile(1), "!", ""), "'", "")

Application.EnableEvents = False
Set wbSource = Nothing
On Error Resume Next
Set wbSource = Workbooks.Open(Filename:=saSourcefile(0), ReadOnly:=True)
On Error GoTo 0
If wbSource Is Nothing Then
    MsgBox prompt:="Unable to open " & saSourcefile(0) & vbCrLf & "Macro abandoned", Buttons:=vbOKOnly + vbCritical
    Exit Sub
End If

On Error Resume Next
Set wsSource = Nothing
Set wsSource = wbSource.Sheets(saSourcefile(1))
On Error GoTo 0
If wsSource Is Nothing Then
    MsgBox prompt:="Unable to access sheet '" & saSourcefile(1) & "'" & vbCrLf & "Macro abandoned", Buttons:=vbOKOnly + vbCritical
    wbSource.Close
    Exit Sub
End If

iCol = 0
With wsSource.UsedRange
    lTargetEnd = .Row + .Rows.Count - 1
End With

For Each rCur In wsInfo.Range(msCopycolumns)
    sColumns = CStr(rCur.Value)
    iCol = iCol + 1
    wsTarget.Columns(GetColLetter(iCol, iCol + wsTarget.Columns(sColumns).Count - 1)).Value = wsSource.Columns(sColumns).Value
Next rCur

wbSource.Close

Application.EnableEvents = True

End Sub

Public Function GetColLetter(ByVal Col1 As Integer, _
                             Optional Col2 As Integer = 0) As String

GetColLetter = GetColLetter1(Col1)
If Col2 > 0 Then GetColLetter = GetColLetter & ":" & GetColLetter1(Col2)

End Function
Private Function GetColLetter1(ByVal Col As Integer) As String
Do
    GetColLetter1 = Chr(65 + (Col - 1) Mod 26) & GetColLetter1
    Col = Int((Col - 1) / 26)
Loop While Col > 0
End Function

 

[gamerosko]

Working.. I just had to delete " ' " on the beggining that was in B1.

Thx much, saved me lot of work.