Need an Macro to copy columns from the Source files and paste in the range mentioned in Target file

Mohaaa · Mar 30, 2023

Hi All
Looking for a macro to copy Columns from the Source files mentioned and paste as is them into the Target file without opening both files, as this code will be saved in a template file separately

We would be receiving files from 5 different persons in xls or xlsb. formats, where the data is not stored in a table format, Hence cannot use the power query so felt to go with Macros. I cannot post the excel file here but explain the requirements in detail. Let me know in case if you have any further questions

I would be keeping a sheet named path, where I will be mentioning the path of all 5 files and ranges as below.

Source Filename	Path for Source file	Sheet name in Source file	Range to be copied from Source files	Path for Target file	Sheet name in Target file	Range to be pasted as is from Source files	No of columns
Person 1	C:\ Person1.xls		Column B- H	C:\ Target.xls		Column B- H	7
Person 2	C:\ Person2xls		Column B- I	C:\ Target.xls		Column K- R	8
Person 3	C:\ Person3.xls		Column B- H	C:\ Target.xls		Column U – AA	7
Person 4	C:\ Person4.xls		Column B- H	C:\ Target.xls		Column AD – AJ	7
Person 5	C:\ Person5.xls		Column B- H	C:\ Target.xls		Column AT-AZ	7

Marc L · Mar 30, 2023

Mohaaa said:
and paste as is them into the Target file without opening both files

Hi, what could that means ?!

Mohaaa · Mar 30, 2023

I meant macro will be stored in a file different from Source & Target files

Marc L · Mar 30, 2023

So « without opening both files » has no sense, just confusing !

But what exactly means « paste as is them » ?!

Mohaaa · Mar 30, 2023

@Marc- I meant as below:
1. Macros are stored in a separate file named as template file
2. This template file should have the tabular information duly filled as below
3. So Macro should access the path of both source and target files without the user opening them manually, which we expect the macro to open the files, copy from the range, and paste into the range

Source Filename	Path for Source file	Sheet name in Source file	Range to be copied from Source files	Path for Target file	Sheet name in Target file	Range to be pasted as is from Source files	No of columns
Person 1	C:\ Person1.xls	BS	Column B- H	C:\ Target.xls	Consol	Column B- H	7
Person 2	C:\ Person2xls	BS	Column B- I	C:\ Target.xls	Consol	Column K- R	8
Person 3	C:\ Person3.xls	BS	Column B- H	C:\ Target.xls	Consol	Column U – AA	7
Person 4	C:\ Person4.xls	BS	Column B- H	C:\ Target.xls	Consol	Column AD – AJ	7
Person 5	C:\ Person5.xls	BS	Column B- H	C:\ Target.xls	Consol	Column AT-AZ	7

Marc L · Mar 30, 2023

So without a crystal clear answer to my previous post the fast ways should not be used

but any beginner way like any Excel user operating manually can do the job, easy with the Macro Recorder …

According to your 'tabular information' no typo is allowed for the columns relative to the full path files names

as 'C:\ Person1.xls' is not valid. The VBA procedure should open only the files found.

Are the Target columns really necessary, the destination workbook / worksheet is not unique ?

Mohaaa · Mar 30, 2023

a. Path, Worksheet name, and Range will be mentioned for both Source and Target(or Destination) files
b. Path of the file name is mentioned in the table is a sample. But felt Macro should read the path mentioned in the table
c. Target columns are required to prevent the user from opening the file manually

Marc L · Mar 30, 2023

Marc L said:
Are the Target columns really necessary, the destination workbook / worksheet is not unique ?

Mohaaa · Mar 30, 2023

Yes, It's needed. The destination file and its worksheet name are unique.

Marc L · Mar 30, 2023

As unique so obviously the two Target columns are totally useless as should be replaced with two cells …

The same for the source worksheet name : unique or may change from source workbooks ?

Mohaaa · Mar 31, 2023

Source Filenames as well is unique.

Marc L · Mar 31, 2023

As I asked not for the source filenames which can very not be unique in the Source column

- now I doubt if you really understand what means unique ! -

but that's about the source worksheet name so again : always the same unique sheet name whatever the source workbook ?

Mohaaa · Apr 2, 2023

Below is the Code I tried. It worked for 1st range alone. Can someone help me with this code in adding multiple Source files?

>>> use code - tags <<<

Code:

Sub TestCopyColumns()
  
    'Set variables for source and target files
    Dim sourceFile As Workbook
    Dim targetFile As Workbook
    Set sourceFile = Workbooks.Open("C:\Users\Admin\Downloads\Source.xlsx")
    Set targetFile = Workbooks.Open("C:\Users\Admin\Downloads\Target.xlsx")
  
    'Set variables for source and target sheets
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Set sourceSheet = sourceFile.Worksheets("BS")
    Set targetSheet = targetFile.Worksheets("BS")
  
    
    'Defined variables and ranges for copy and paste
    Dim sourceRange As Range
    Dim targetRange As Range
    Set sourceRange = sourceSheet.Columns("B:H")
    Set targetRange = targetSheet.Columns("B:H")
  
    'Copy and paste the range
    sourceRange.Copy Destination:=targetRange
  
    'Closing both source and target files
    sourceFile.Close SaveChanges:=False
    targetFile.Close SaveChanges:=True
  
End Sub

Marc L · Apr 2, 2023

As per this forum rules you have to edit your post and use the Code option from the 3 dots menu, even for such tragic code …

Without any answer to my easy question so you can get inspired with the many blogs / forums samples for this common subject

like for example Consolidate data from different excel files (VBA) …

rlv01 · Apr 3, 2023

Col A	Col B	Col C	Col D	Col E	Col F	Col G	Col H
Source Filename	Path for Source file	Sheet name in Source file	Columns to be copied from Source files	Path for Target file	Sheet name in Target file	Range to be pasted as is from Source files	No of columns
Person 1	C:\Temp\Person1.xlsx	BS	Column B- H	C:\Temp\Target.xlsx	BS	Column B- H	7
Person 2	C:\Temp\Person2.xlsx	BS	Column B- I	C:\Temp\Target.xlsx	BS	Column K- R	8
Person 3	C:\Temp\Person3.xlsx	BS	Column B- H	C:\Temp\Target.xlsx	BS	Column U – AA	7
Person 4	C:\Temp\Person4.xlsx	BS	Column B- H	C:\Temp\Target.xlsx	BS	Column AD – AJ	7
Person 5	C:\Temp\Person5.xlsx	BS	Column B- H	C:\Temp\Target.xlsx	BS	Column AT-AZ	7

Mohaaa said:
Below is the Code I tried. It worked for 1st range alone. Can someone help me with this code in adding multiple Source files?

Maybe something like this.

Code:

Sub TestCopyColumns2()
    Dim I As Long
    Dim FSO As Object
    Dim R As Range, rngColData As Range, sourceRange As Range, targetRange As Range
    Dim S As String, SaveState As Boolean
    Dim sourceFile As Workbook, targetFile As Workbook
    Dim sourceSheet As Worksheet, targetSheet As Worksheet, WS As Worksheet

    On Error Resume Next
    Set WS = ThisWorkbook.Worksheets("FolderData")
    On Error GoTo 0
    If WS Is Nothing Then
        MsgBox "This workbook must contain a worksheet named 'FolderData' to contain information about your files and ranges", vbOKOnly Or vbInformation, Application.Name
        Exit Sub
    End If

    Set FSO = CreateObject("Scripting.FileSystemObject")

    With WS
        Set rngColData = .Range("B2", .Range("B" & .Rows.Count).End(xlUp))
    End With

    For Each R In rngColData
        'Check files
        For I = 0 To 3
            Select Case I
            Case 0, 3
                If Not FSO.FileExists(R.Offset(0, I).Value) Then
                    MsgBox "File not found:" & vbCrLf & vbCrLf _
                         & R.Offset(0, I).Value, vbOKOnly Or vbExclamation, Application.Name
                    Exit Sub
                End If
            End Select
        Next I

        'Open workbooks
        Set sourceFile = Workbooks.Open(R.Offset.Value)
        Set targetFile = Workbooks.Open(R.Offset(0, 3).Value)

        'Set variables for source and target sheets
        Set sourceSheet = Nothing
        Set targetSheet = Nothing
        On Error Resume Next
        Set sourceSheet = sourceFile.Worksheets(R.Offset(0, 1).Value)
        Set targetSheet = targetFile.Worksheets(R.Offset(0, 4).Value)
        On Error GoTo 0

        If sourceSheet Is Nothing Then
            If MsgBox(sourceFile.Name & " worksheet " & R.Offset(0, 1).Value & " not found" & vbCr & vbCr & "Continue?", vbOKCancel Or vbExclamation, Application.Name) = vbOK Then
                SaveState = False
                GoTo Nextfile
            Else
                GoTo QuitProcessing
            End If
        End If
        If targetSheet Is Nothing Then
            If MsgBox(targetFile.Name & " worksheet " & R.Offset(0, 1).Value & " not found" & vbCr & vbCr & "Continue?", vbOKCancel Or vbExclamation, Application.Name) = vbOK Then
                SaveState = False
                GoTo Nextfile
            Else
                GoTo QuitProcessing
            End If
        End If

        'Define & validate copy/paste ranges
        Set sourceRange = Nothing
        Set targetRange = Nothing
       
        S = Replace(Replace(Replace(R.Offset(0, 2).Value, " ", ""), "Column", ""), "-", ":")
        On Error Resume Next
        Set sourceRange = sourceSheet.Columns(S)

        S = Replace(Replace(Replace(R.Offset(0, 5).Value, " ", ""), "Column", ""), "-", ":")
        Set targetRange = targetSheet.Columns(Split(S, ":")(0))
        On Error GoTo 0
       
        If sourceRange Is Nothing Then
            If MsgBox(sourceFile.Name & " range '" & R.Offset(0, 2).Value & "' is invalid" & vbCr & vbCr & "Continue?", vbOKCancel Or vbExclamation, Application.Name) = vbOK Then
                SaveState = False
                GoTo Nextfile
            Else
                GoTo QuitProcessing
            End If
        End If
        If targetRange Is Nothing Then
            If MsgBox(targetFile.Name & " range '" & R.Offset(0, 5).Value & "' is invalid" & vbCr & vbCr & "Continue?", vbOKCancel Or vbExclamation, Application.Name) = vbOK Then
                SaveState = False
                GoTo Nextfile
            Else
                GoTo QuitProcessing
            End If
        End If
       
        'Copy and paste the range
        sourceRange.Copy Destination:=targetRange
        SaveState = True
Nextfile:
        'Closing both source and target files
        sourceFile.Close SaveChanges:=False
        targetFile.Close SaveChanges:=SaveState
    Next R
    Exit Sub
QuitProcessing:
    'Clean up
    sourceFile.Close SaveChanges:=False
    targetFile.Close SaveChanges:=False
End Sub

Mohaaa · Apr 4, 2023

rlv01 said:

Col A	Col B	Col C	Col D	Col E	Col F	Col G	Col H
Source Filename	Path for Source file	Sheet name in Source file	Columns to be copied from Source files	Path for Target file	Sheet name in Target file	Range to be pasted as is from Source files	No of columns
Person 1	C:\Temp\Person1.xlsx	BS	Column B- H	C:\Temp\Target.xlsx	BS	Column B- H	7
Person 2	C:\Temp\Person2.xlsx	BS	Column B- I	C:\Temp\Target.xlsx	BS	Column K- R	8
Person 3	C:\Temp\Person3.xlsx	BS	Column B- H	C:\Temp\Target.xlsx	BS	Column U – AA	7
Person 4	C:\Temp\Person4.xlsx	BS	Column B- H	C:\Temp\Target.xlsx	BS	Column AD – AJ	7
Person 5	C:\Temp\Person5.xlsx	BS	Column B- H	C:\Temp\Target.xlsx	BS	Column AT-AZ	7

Maybe something like this.

Code:

Sub TestCopyColumns2()
    Dim I As Long
    Dim FSO As Object
    Dim R As Range, rngColData As Range, sourceRange As Range, targetRange As Range
    Dim S As String, SaveState As Boolean
    Dim sourceFile As Workbook, targetFile As Workbook
    Dim sourceSheet As Worksheet, targetSheet As Worksheet, WS As Worksheet

    On Error Resume Next
    Set WS = ThisWorkbook.Worksheets("FolderData")
    On Error GoTo 0
    If WS Is Nothing Then
        MsgBox "This workbook must contain a worksheet named 'FolderData' to contain information about your files and ranges", vbOKOnly Or vbInformation, Application.Name
        Exit Sub
    End If

    Set FSO = CreateObject("Scripting.FileSystemObject")

    With WS
        Set rngColData = .Range("B2", .Range("B" & .Rows.Count).End(xlUp))
    End With

    For Each R In rngColData
        'Check files
        For I = 0 To 3
            Select Case I
            Case 0, 3
                If Not FSO.FileExists(R.Offset(0, I).Value) Then
                    MsgBox "File not found:" & vbCrLf & vbCrLf _
                         & R.Offset(0, I).Value, vbOKOnly Or vbExclamation, Application.Name
                    Exit Sub
                End If
            End Select
        Next I

        'Open workbooks
        Set sourceFile = Workbooks.Open(R.Offset.Value)
        Set targetFile = Workbooks.Open(R.Offset(0, 3).Value)

        'Set variables for source and target sheets
        Set sourceSheet = Nothing
        Set targetSheet = Nothing
        On Error Resume Next
        Set sourceSheet = sourceFile.Worksheets(R.Offset(0, 1).Value)
        Set targetSheet = targetFile.Worksheets(R.Offset(0, 4).Value)
        On Error GoTo 0

        If sourceSheet Is Nothing Then
            If MsgBox(sourceFile.Name & " worksheet " & R.Offset(0, 1).Value & " not found" & vbCr & vbCr & "Continue?", vbOKCancel Or vbExclamation, Application.Name) = vbOK Then
                SaveState = False
                GoTo Nextfile
            Else
                GoTo QuitProcessing
            End If
        End If
        If targetSheet Is Nothing Then
            If MsgBox(targetFile.Name & " worksheet " & R.Offset(0, 1).Value & " not found" & vbCr & vbCr & "Continue?", vbOKCancel Or vbExclamation, Application.Name) = vbOK Then
                SaveState = False
                GoTo Nextfile
            Else
                GoTo QuitProcessing
            End If
        End If

        'Define & validate copy/paste ranges
        Set sourceRange = Nothing
        Set targetRange = Nothing
      
        S = Replace(Replace(Replace(R.Offset(0, 2).Value, " ", ""), "Column", ""), "-", ":")
        On Error Resume Next
        Set sourceRange = sourceSheet.Columns(S)

        S = Replace(Replace(Replace(R.Offset(0, 5).Value, " ", ""), "Column", ""), "-", ":")
        Set targetRange = targetSheet.Columns(Split(S, ":")(0))
        On Error GoTo 0
      
        If sourceRange Is Nothing Then
            If MsgBox(sourceFile.Name & " range '" & R.Offset(0, 2).Value & "' is invalid" & vbCr & vbCr & "Continue?", vbOKCancel Or vbExclamation, Application.Name) = vbOK Then
                SaveState = False
                GoTo Nextfile
            Else
                GoTo QuitProcessing
            End If
        End If
        If targetRange Is Nothing Then
            If MsgBox(targetFile.Name & " range '" & R.Offset(0, 5).Value & "' is invalid" & vbCr & vbCr & "Continue?", vbOKCancel Or vbExclamation, Application.Name) = vbOK Then
                SaveState = False
                GoTo Nextfile
            Else
                GoTo QuitProcessing
            End If
        End If
      
        'Copy and paste the range
        sourceRange.Copy Destination:=targetRange
        SaveState = True
Nextfile:
        'Closing both source and target files
        sourceFile.Close SaveChanges:=False
        targetFile.Close SaveChanges:=SaveState
    Next R
    Exit Sub
QuitProcessing:
    'Clean up
    sourceFile.Close SaveChanges:=False
    targetFile.Close SaveChanges:=False
End Sub

Thanks for sharing this code. but it worked only for 1st and 2nd files alone. Attached is the files I used. Can I ask for your help to guide me on fixing this ?

Note: Macro is stored in the file named CopyPaste_Macro2.xlsm, while the copy of 5 source files and 1 Target file.

Marc L · Apr 4, 2023

So it's seems easier to attach files rather than answer to easy questions !

Next time attach the necessary files directly in the initial post, should avoid to waste time …

rlv01 · Apr 4, 2023

Mohaaa said:
Thanks for sharing this code. but it worked only for 1st and 2nd files alone. Attached is the files I used. Can I ask for your help to guide me on fixing this ?

Note: Macro is stored in the file named CopyPaste_Macro2.xlsm, while the copy of 5 source files and 1 Target file.

Fix your data table so that the col G column "-" separator characters are all ascii 45 dashes instead of a mix of ascii 45 and ascii 150 and the code should work.

With respect to problems, part of the deal is that you must explain and describe instead of just saying the code did not work. Please don't make me guess. Tell me how it didn't work?, Describe in what way did it fail? Report any error messages you observed.

Mohaaa · Apr 4, 2023

Marc L said:
So it's seems easier to attach files rather than answer to easy questions !
Next time attach the necessary files directly in the initial post, should avoid to waste time …

Sorry Marc - I tried answering all your questions to my knowledge. Not clear with your last one. can you clarify again ?

Marc L · Apr 5, 2023

You should understand with this post … Assuming your post #16 attachment is smart enough so well reflecting the real source workbooks

(if not your attachment has no sense !) then just removing the useless according to the below attachment with this short VBA demonstration :

Code:

Sub Demo1()
        V = [A1].CurrentRegion:  If IsEmpty(V(3, 1)) Then [A3].Select: Beep: Exit Sub
        If Dir(V(3, 1), 16) <> "." Then [A3].Select: Beep: Exit Sub
        If Dir(V(3, 1) & V(3, 3)) = "" Or IsEmpty(V(3, 3)) Then [C3].Select: Beep: Exit Sub
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    With Workbooks.Open(V(3, 1) & V(3, 3), 0).ActiveSheet
           .UsedRange.Clear
        For R& = 5 To UBound(V)
            If Dir(V(3, 1) & V(R, 1)) > "" Then
                Workbooks.Open V(3, 1) & V(R, 1), 0
                ActiveSheet.UsedRange.Copy .Cells(1, V(R, 2))
                ActiveWorkbook.Close False
            End If
        Next
    End With
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !

Mohaaa · Apr 5, 2023

rlv01 said:
Fix your data table so that the col G column "-" separator characters are all ascii 45 dashes instead of a mix of ascii 45 and ascii 150 and the code should work.
View attachment 83731

With respect to problems, part of the deal is that you must explain and describe instead of just saying the code did not work. Please don't make me guess. Tell me how it didn't work?, Describe in what way did it fail? Report any error messages you observed.

Many Thanks, it worked fine. Just curious to ask in case if I want to copy specific cells instead of specific Columns, How should I amend the code ?

Marc L · Apr 5, 2023

Just with the Excel range address like obviously B9:H100 and an optimized VBA procedure …

Mohaaa · Apr 5, 2023

I updated the range as B2:H11 and got the error messages as attached. Pls advise.

Marc L · Apr 5, 2023

As you did not fit the VBA procedure accordingly like warned in my previous post !

As my post #20 short way - needing less than 30 codelines - does not use useless columns

- an Excel basics reminder : as a range can contain a worksheet reference - so just wait

until rlv01 has the time to revise its code or just try my post #14 link …

rlv01 · Apr 5, 2023

Source. Filename

Path for Source file

Sheet name in Source file

Range to be copied from Source files

Path for Target file

Sheet name in Target file

Paste Range

Person 1

C:\Temp\Person1.xlsx

BS

Column B2:H11

C:\Temp\Target.xlsx

BS

Column B9:H18

Person 2

C:\Temp\Person2.xlsx

BS

Column B2:H11

C:\Temp\Target.xlsx

BS

Column K9:Q18

Perhaps this.

Code:

Sub TestCopyColumns2()
    Dim I As Long
    Dim FSO As Object
    Dim R As Range, rngColData As Range, sourceRange As Range, targetRange As Range
    Dim S As String, SaveState As Boolean
    Dim sourceFile As Workbook, targetFile As Workbook
    Dim sourceSheet As Worksheet, targetSheet As Worksheet, WS As Worksheet

    On Error Resume Next
    Set WS = ThisWorkbook.Worksheets("FolderData")
    On Error GoTo 0
    If WS Is Nothing Then
        MsgBox "This workbook must contain a worksheet named 'FolderData' to contain information about your files and ranges", vbOKOnly Or vbInformation, Application.Name
        Exit Sub
    End If

    Set FSO = CreateObject("Scripting.FileSystemObject")

    With WS
        Set rngColData = .Range("B2", .Range("B" & .Rows.Count).End(xlUp))
    End With

    For Each R In rngColData
        'Check files
        For I = 0 To 3
            Select Case I
            Case 0, 3
                If Not FSO.FileExists(R.Offset(0, I).Value) Then
                    MsgBox "File not found:" & vbCrLf & vbCrLf _
                         & R.Offset(0, I).Value, vbOKOnly Or vbExclamation, Application.Name
                    Exit Sub
                End If
            End Select
        Next I

        'Open workbooks
        Set sourceFile = Workbooks.Open(R.Offset.Value)
        Set targetFile = Workbooks.Open(R.Offset(0, 3).Value)

        'Set variables for source and target sheets
        Set sourceSheet = Nothing
        Set targetSheet = Nothing
        On Error Resume Next
        Set sourceSheet = sourceFile.Worksheets(R.Offset(0, 1).Value)
        Set targetSheet = targetFile.Worksheets(R.Offset(0, 4).Value)
        On Error GoTo 0

        If sourceSheet Is Nothing Then
            If MsgBox(sourceFile.Name & " worksheet " & R.Offset(0, 1).Value & " not found" & vbCr & vbCr & "Continue?", vbOKCancel Or vbExclamation, Application.Name) = vbOK Then
                SaveState = False
                GoTo Nextfile
            Else
                GoTo QuitProcessing
            End If
        End If
        If targetSheet Is Nothing Then
            If MsgBox(targetFile.Name & " worksheet " & R.Offset(0, 1).Value & " not found" & vbCr & vbCr & "Continue?", vbOKCancel Or vbExclamation, Application.Name) = vbOK Then
                SaveState = False
                GoTo Nextfile
            Else
                GoTo QuitProcessing
            End If
        End If

        'Define & validate copy/paste ranges
        Set sourceRange = Nothing
        Set targetRange = Nothing

        S = Replace(Replace(Replace(R.Offset(0, 2).Value, " ", ""), "Column", ""), "-", ":")
        On Error Resume Next
        Set sourceRange = sourceSheet.Range(S)

        S = Replace(Replace(Replace(R.Offset(0, 5).Value, " ", ""), "Column", ""), "-", ":")
        S = Split(S, ":")(0)
        Set targetRange = targetSheet.Range(S)
        On Error GoTo 0

        If sourceRange Is Nothing Then
            If MsgBox(sourceFile.Name & " range '" & R.Offset(0, 2).Value & "' is invalid" & vbCr & vbCr & "Continue?", vbOKCancel Or vbExclamation, Application.Name) = vbOK Then
                SaveState = False
                GoTo Nextfile
            Else
                GoTo QuitProcessing
            End If
        End If
        If targetRange Is Nothing Then
            If MsgBox(targetFile.Name & " range '" & R.Offset(0, 5).Value & "' is invalid" & vbCr & vbCr & "Continue?", vbOKCancel Or vbExclamation, Application.Name) = vbOK Then
                SaveState = False
                GoTo Nextfile
            Else
                GoTo QuitProcessing
            End If
        End If

        'Copy and paste the range
        sourceRange.Copy Destination:=targetRange
        SaveState = True
Nextfile:
        'Closing both source and target files
        sourceFile.Close SaveChanges:=False
        targetFile.Close SaveChanges:=SaveState
    Next R
    Exit Sub
QuitProcessing:
    'Clean up
    sourceFile.Close SaveChanges:=False
    targetFile.Close SaveChanges:=False
End Sub

Need an Macro to copy columns from the Source files and paste in the range mentioned in Target file

New Member

Excel Ninja

New Member

Excel Ninja

New Member

Excel Ninja

New Member

Excel Ninja

New Member

Excel Ninja

New Member

Excel Ninja

New Member

Excel Ninja

Member

New Member

Attachments

Excel Ninja

Member

New Member

Excel Ninja

Attachments

New Member

Excel Ninja

New Member

Attachments

Excel Ninja

Member