Copy content of one excel to another if matching the sheet name

[mohanraj.610]

I am working on two excels with several hundred rows. I need to copy contents of the source to Destination excel if the sheet name matches.

Sheet mapping: I need copy contents from source to destination if the sheet names matches as per the mapping table.

Attribute mapping: After matching the sheet name it needs to check the column header and copy the contents.

[mohanraj.610]

I have two templates Source and Destination. Source has sheet name as "Sheet 1", "sheet 2" "sheet 3" as such,

Destination sheet name: A, B, C..

I want to map the sheet names and copy the contents of Sheet 1 to C, Sheet 3 to A like that from a mapping table.

And also Column mapping should be done based on header. And copy contents to the destination.

Please help me out!

[SamT]

Mohanraj,

I moved this thread from the Site and Forum Related folder to the Excel Folder, then I deleted the duplicate thread (Copy content of one excel to another if the sheet name matches (http://www.vbaexpress.com/forum/showthread.php?53529-Copy-content-of-one-excel-to-another-if-the-sheet-name-matches)) in the Excel folder.

You also asked the question in at least one other non related thread. This is Shotgunning and will not make you any friends. It is as rude as hiring 3 helpers to get in three lines at the market and for them and you to push your way to the fronts of the lines.

For today, and today only, we will assume that you did not know how to use a help forum and we will forgive the transgression.

If you do this again, you will be banned.

We do hope that you will continue to use VBA Express for your coding assistance, and we will do the best we can for you.

Thank you,
The Moderators.

[SamT]

I have two templates Source and Destination. Source has sheet name as "Sheet 1", "sheet 2" "sheet 3" as such,

Destination sheet name: A, B, C..

I want to map the sheet names and copy the contents of Sheet 1 to C, Sheet 3 to A like that from a mapping table.

And also Column mapping should be done based on header. And copy contents to the destination.

Please help me out!

Sub Master()
'For help, see: "http://www.vbaexpress.com/forum/showthread.php?53528-Copy-content-of-one-excel-to-another-if-matching-the-sheet-name"
Dim rw As Range
Dim MapTable As Range
Dim SrcSht As String
Dim DestSht As String

Set MapTable = Sheets("Map").Range("A2:B4") 'Adjust as needed
For Each rw In MapTable.Rows
With rw
SrcSht = .Cells(1).Value 'Adjust as needed
DestSht = .Cells(2).Value
TransferData SrcSht, DestSht
End With
Next rw
End Sub

Sub TransferData(SrcSht As String, DestSht As String)
Dim DestSheet As Worksheet
Dim SrcSheet As Worksheet

Dim DestHeaders As Range
Dim SrcHeaders As Range

Dim DestCell As Range
Dim SrcData As Range
Dim SrcHead As Range

Dim Cel As Range


Set DestSheet = ThisWorkbook.Sheets(DestSht)
Set SrcSheet = Workbooks("Source.xls?").Sheets(SrcSht) 'Adjust as needed

Set DestHeaders = DestSheet.Range("A1:X1") 'Adjust as needed
Set SrcHeaders = SrcSheet.Range("A1:X1")

For Each Cel In DestHeaders
Set DestCell = Cel.End(xlDown).Offset(1, 0) 'To Append new data to bottom of column
Set SrcHead = SrcHeaders.Find(Cel.Value)
Set SrcData = Range(SrcHead.Offset(1, 0), SrcHead.End(xlDown))
SrcData.Copy DestCell
Next Cel

End Sub

[mancubus]

and it's not polite to force users reply the threads via PMs.

we are not paid employees here and try to help requesters voluntarily.


anyone new to the forum can be sure if the helpers have time (yes, they run their own businesses or work as professionals :D ) and desire :) to work on a thread and come up with a solution, they definitely post it here.

[mohanraj.610]

Dear SamT,

I am first time user to this Forum and i found there was a similar thread to my query so i have posted there. then i realised i need to start a new thread. Thanks for the information.

However code is not working. I have attached the sheet for reference.

First i need to map the article types in the source sheet and destination. Mapping table is given in "Article type mapping"

After the article type is mapped i need to map the column headers and copy contents from this. It is given in "Template Mapping"

I need to do this for several hundreds between source and destination.

Thanks in Advance!

[mohanraj.610]

Hi Sam and Mancubus,

I was really not intended to do that. Since i found you reverted on similar thread i just replied you. I am just new to this Forum.

Thanks for understanding.

[SamT]

Hi Sam and Mancubus,

I was really not intended to do that. Since i found you reverted on similar thread i just replied you. I am just new to this Forum.

Thanks for understanding.

Not a problem, it happens often with new members.

[SamT]

Uhhh...In your attachment, is "Article Type Mapping" the Worksheet Map. AND is "Template Mapping" the Header Map"

These two tables do not correspond


Source Article Type
Destination Article Type


bodysuit_sleepsuit

Bodysuit


bodysuit_sleepsuit

Sleepsuit


dungaree_romper
Dungarees






Article Type
Source Header
Destination Header


Bodysuit

Seller SKU ID
SKU


Bodysuit
Brand
brand


Bodysuit
Size
Size



Etc






The code will need a table like


Source Sheet

Source Header

Dest Sheet
Destination Header


bodysuit_sleepsuit
Seller SKU ID
Sleepsuit
SKU


bodysuit_sleepsuit
Brand
Sleepsuit
brand


bodysuit_sleepsuit
Size
Sleepsuit
Size



Etcetera

[mohanraj.610]

Hi,

It is showing as Run time error. I have attached files as how i worked. Kindly refer and tell me where i went wrong.

Thanks in advance

[SamT]

In Sub Master, DestSht Address should be .Cells(3)

'<<< marks the changes I made in this code

Sub TransferData(SrcSht As String, DestSht As String)
Dim DestSheet As Worksheet
Dim SrcSheet As Worksheet
Dim SrcHeadName As String '<<<<<<<<<

Dim DestHeaders As Range
Dim SrcHeaders As Range

Dim DestCell As Range
Dim DestHeadMap As Range
Dim SrcData As Range

Dim Cel As Range



Set SrcSheet = Workbooks("Source.xlsx").Sheets(SrcSht) 'Adjust as needed
Set DestSheet = Workbooks("Destination.xlsx").Sheets(DestSht)

Set SrcHeadMap = ThisWorkbook.Sheets("Map").Range("D2:D4") '<<<<<<

Set SrcHeaders = SrcSheet.Range("A1:C6")
Set DestHeaders = DestSheet.Range("A1:C6") 'Adjust as needed

For Each Cel In DestHeaders
SrcHeadName = DestHeadMap.Find(Cel.Value).Offset(0, -2).Value '<<<<<<
Set DestCell = Cel.End(xlDown).Offset(1, 0) '<<<<<<<<<<< 'To Append new data to bottom of column
Set SrcHead = SrcHeaders.Find(SrcHeadName) '<<<<<<<<
Set SrcData = Range(SrcHead.Offset(1, 0), SrcHead.End(xlDown))
SrcData.Copy DestCell
Next Cel

End Sub

[mohanraj.610]

Its not working1423314234


Sub Master()

Dim rw As Range
Dim MapTable As Range
Dim SrcSht As String
Dim DestSht As String

Set MapTable = Sheets("Map").Range("A2:D4") 'Adjust as needed
For Each rw In MapTable.Rows
With rw
SrcSht = .Cells(1).Value 'Adjust as needed
DestSht = .Cells(3).Value
TransferData SrcSht, DestSht
End With
Next rw
End Sub
Sub TransferData(SrcSht As String, DestSht As String)
Dim DestSheet As Worksheet
Dim SrcSheet As Worksheet
Dim SrcHeadName As String

Dim DestHeaders As Range
Dim SrcHeaders As Range

Dim DestCell As Range
Dim DestHeadMap As Range
Dim SrcData As Range

Dim Cel As Range



Set SrcSheet = Workbooks("Source.xlsx").Sheets(SrcSht)
Set DestSheet = Workbooks("Destination.xlsx").Sheets(DestSht)

Set SrcHeadMap = ThisWorkbook.Sheets("Map").Range("D2:D4")

Set SrcHeaders = SrcSheet.Range("A1:C6")
Set DestHeaders = DestSheet.Range("A1:C6") 'Adjust as needed

For Each Cel In DestHeaders
SrcHeadName = DestHeadMap.Find(Cel.Value).Offset(0, -2).Value
Set DestCell = Cel.End(xlDown).Offset(1, 0)
Set SrcHead = SrcHeaders.Find(SrcHeadName)
Set SrcData = Range(SrcHead.Offset(1, 0), SrcHead.End(xlDown))
SrcData.Copy DestCell
Next Cel

End Sub

[SamT]

I really did think that I had changed all of them. I am sorry.

Change

SrcHeadMap
To

DestHeadMap

In the line that errored out, the Range Object "DestHeadMap" had not been set. There is no Range Object "SrcHeadMap" Declared in the Dim Statements, because it was not needed/used.

[mohanraj.610]

I am getting the same error. Object variable not set. I have made changes as DestHeadMap "Set DestHeadMap = ThisWorkbook.Sheets("Map").Range("D2:D4")"


It is showing object not set

SrcHeadName = DestHeadMap.Find(Cel.Value).Offset(0, -2).Value

[SamT]

I rewrote the code and rearranged sheets "Map" so they corresponded to each other.

[mohanraj.610]

Its working. Thank you so much.