Run Time Error - Copying data from one workbook to another based on different headers as well as their positions

wo_ofberry

New Member
Joined
Feb 5, 2023
Messages
6
Office Version
  1. 365
Platform
  1. Windows
I am copying data from Sourcebook1 to targetbook1.

Sourcebook1:
Sourcebook1.xlsx
ABCDEFGHIJKLM
1
2
3
4
5
6
7
8
9
10Sourcebook1
11
12
13
14
15
16
17
18
192345678910
20DateComments at Order TimeComments on iPadName of signeeLocationDateDO No.Product DescriptionDO Qty
21123.00132.00141.00150.00159.00168.00177.00186.00195.00
22124.00133.00142.00151.00160.00169.00178.00187.00196.00
23125.00134.00143.00152.00161.00170.00179.00188.00197.00
24126.00135.00144.00153.00162.00171.00180.00189.00198.00
25127.00136.00145.00154.00163.00172.00181.00190.00199.00
26128.00137.00146.00155.00164.00173.00182.00191.00200.00
27129.00138.00147.00156.00165.00174.00183.00192.00201.00
28130.00139.00148.00157.00166.00175.00184.00193.00202.00
29131.00140.00149.00158.00167.00176.00185.00194.00203.00
30
31
32
Sheet1


targetbook1
Targetbook1.xlsx
ABCDEFGHIJKLMN
1Targetbook1
2456789101112
3For Month (YYYY MM)Comments at Order TimeComments on iPadName of signeeFor TAK or Subcon? [HSUENCHOW/Pintary/ BBR/ KKL..etc]DateDO No.1Qty
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sheet1




Below is my attempt code, it has run time error after 'Copy the data to the target workbook. Notice that the positions of the headers are very different, as well as the headers of targetbook1 are merged cells. Please assist in resolving the error.

VBA Code:
Option Explicit

Sub CopyData()

Dim sourceWorkbook As Workbook
Dim targetWorkbook As Workbook
Dim headerMap As Object

'Open the source workbook
Set sourceWorkbook = Workbooks.Open("C:\Users\User\Desktop\Trial 1\Sourcebook1.xlsx")

'Open the target workbook
Set targetWorkbook = Workbooks.Open("C:\Users\User\Desktop\Trial 1\Targetbook1.xlsx")

'Define the columns you want to copy
Dim column1 As String
Dim column2 As String
Dim column3 As String
Dim column4 As String
Dim column5 As String
Dim column6 As String
Dim column7 As String
Dim column8 As String
Dim column9 As String

'Set the column header names in the source workbook
column1 = "Date"
column2 = "Comments at Order Time"
column3 = "Comments on iPad"
column4 = "Name of signee"
column5 = "Location"
column6 = "Date"
column7 = "DO No."
column8 = "Product Description"
column9 = "DO Qty"

'Find the row number of the column header names in the source workbook
Dim column1Row As Integer
Dim column2Row As Integer
Dim column3Row As Integer
Dim column4Row As Integer
Dim column5Row As Integer
Dim column6Row As Integer
Dim column7Row As Integer
Dim column8Row As Integer
Dim column9Row As Integer

column1Row = 20
column2Row = 20
column3Row = 20
column4Row = 20
column5Row = 20
column6Row = 20
column7Row = 20
column8Row = 20
column9Row = 20

Dim i As Integer

For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 1) = column1 Then
column1Row = i
Exit For
End If
Next i


For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 1) = column2 Then
column2Row = i
Exit For
End If
Next i


For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 1) = column3 Then
column3Row = i
Exit For
End If
Next i



For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 1) = column4 Then
column4Row = i
Exit For
End If
Next i



For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 1) = column5 Then
column5Row = i
Exit For
End If
Next i



For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 1) = column6 Then
column6Row = i
Exit For
End If
Next i



For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 1) = column7 Then
column7Row = i
Exit For
End If
Next i



For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 1) = column8 Then
column8Row = i
Exit For
End If
Next i



For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 1) = column9 Then
column9Row = i
Exit For
End If
Next i





'Define a dictionary to store the mapping of header names

Set headerMap = CreateObject("Scripting.Dictionary")

'Map the header names between the source and target workbooks
headerMap("Date") = "For Month (YYYY MM)"
headerMap("Comments at Order Time") = "Comments at Order Time"
headerMap("Comments on iPad") = "Comments on iPad"
headerMap("Name of signee") = "Name of signee"
headerMap("Location") = "For TAK or Subcon? [HSUENCHOW/Pintary/ BBR/ KKL..etc]"
headerMap("Date") = "Date"
headerMap("DO No.") = "DO No."
headerMap("Product Description") = "1"
headerMap("DO Qty") = "Qty"


'Find the row number of the target headers
Dim targetHeader1Row As Integer
Dim targetHeader2Row As Integer
Dim targetHeader3Row As Integer
Dim targetHeader4Row As Integer
Dim targetHeader5Row As Integer
Dim targetHeader6Row As Integer
Dim targetHeader7Row As Integer
Dim targetHeader8Row As Integer
Dim targetHeader9Row As Integer

targetHeader1Row = 3
targetHeader2Row = 3
targetHeader3Row = 3
targetHeader4Row = 3
targetHeader5Row = 3
targetHeader6Row = 3
targetHeader7Row = 3
targetHeader8Row = 3
targetHeader9Row = 3


For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 1) = headerMap(column1) Then
targetHeader1Row = i
Exit For
End If
Next i



For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 1) = headerMap(column2) Then
targetHeader2Row = i
Exit For
End If
Next i



For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 1) = headerMap(column3) Then
targetHeader3Row = i
Exit For
End If
Next i



For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 1) = headerMap(column4) Then
targetHeader4Row = i
Exit For
End If
Next i



For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 1) = headerMap(column5) Then
targetHeader5Row = i
Exit For
End If
Next i



For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 1) = headerMap(column6) Then
targetHeader6Row = i
Exit For
End If
Next i



For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 1) = headerMap(column7) Then
targetHeader7Row = i
Exit For
End If
Next i



For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 1) = headerMap(column8) Then
targetHeader8Row = i
Exit For
End If
Next i


For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 1) = headerMap(column9) Then
targetHeader9Row = i
Exit For
End If
Next i


'Find the end row of the merged cells in the target workbook
Dim targetHeader1EndRow As Integer
Dim targetHeader2EndRow As Integer
Dim targetHeader3EndRow As Integer
Dim targetHeader4EndRow As Integer
Dim targetHeader5EndRow As Integer
Dim targetHeader6EndRow As Integer
Dim targetHeader7EndRow As Integer
Dim targetHeader8EndRow As Integer
Dim targetHeader9EndRow As Integer


targetHeader1EndRow = targetHeader1Row + 1
targetHeader2EndRow = targetHeader2Row + 1
targetHeader3EndRow = targetHeader3Row + 1
targetHeader4EndRow = targetHeader4Row + 1
targetHeader5EndRow = targetHeader5Row + 1
targetHeader6EndRow = targetHeader6Row + 1
targetHeader7EndRow = targetHeader7Row + 1
targetHeader8EndRow = targetHeader8Row + 1
targetHeader9EndRow = targetHeader9Row + 1

'Copy the data to the target workbook
    targetWorkbook.Sheets(1).Range(targetWorkbook.Sheets(1).Cells(targetHeader1EndRow, 4),targetWorkbook.Sheets(1).Cells(targetHeader2EndRow,5),targetWorkbook.Sheets(1).Cells(targetHeader3EndRow,6),targetWorkbook.Sheets(1).Cells(targetHeader4EndRow, 7),targetWorkbook.Sheets(1).Cells(targetHeader5EndRow,8),targetWorkbook.Sheets(1).Cells(targetHeader6EndRow,9),targetWorkbook.Sheets(1).Cells(targetHeader7EndRow,10),targetWorkbook.Sheets(1).Cells(targetHeader8EndRow,11),targetWorkbook.Sheets(1).Cells(targetHeader9EndRow,12)).Value=sourceWorkbook.Sheets(1).Range(sourceWorkbook.Sheets(1).Cells(column1Row,2),sourceWorkbook.Sheets(1).Cells(column2Row,3),sourceWorkbook.Sheets(1).Cells(column3Row,4),sourceWorkbook.Sheets(1).Cells(column4Row,5),sourceWorkbook.Sheets(1).Cells(column5Row,6),sourceWorkbook.Sheets(1).Cells(column6Row,7),sourceWorkbook.Sheets(1).Cells(column7Row,8),sourceWorkbook.Sheets(1).Cells(column8Row,9),sourceWorkbook.Sheets(1).Cells(column9Row,10)).Value




'Save and close the workbooks
sourceWorkbook.Close savechanges:=False


End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Instead of trying to decipher your code, it would be easier to help if you could explain in words what you are trying to do referring to specific workbooks, cells, rows, columns and sheets using a few examples from your data.
 
Upvote 0
Instead of trying to decipher your code, it would be easier to help if you could explain in words what you are trying to do referring to specific workbooks, cells, rows, columns and sheets using a few examples from your data.
Right, I updated the code at the end as i realised i made a huge mistake.

The code is a VBA macro to copy data from one Excel workbook to another.
  1. It opens the source and target workbooks using the Workbooks.Open method.
  2. It defines the columns you want to copy using variables such as column1, column2, column3, etc.
  3. It finds the row number of each column header name in the source workbook using a For loop and an If statement.
  4. It creates a dictionary called headerMap to store the mapping of header names between the source and target workbooks.
  5. It finds the row number of the target headers using a similar approach as step 3.
  6. Finally, it copies the data from the source workbook to the target workbook by looping through the rows and checking if the cells in the source workbook contain data. If so, it maps the column names from the source to the target and copies the data.
----

Here are the explanation to the codes in blocks.

let say copying cell B21 integer (123.00) from Sourcebook1 into cell D5 of targetbook1.

I declare Dictionary object in the code by adding

VBA Code:
Option Explicit
and
VBA Code:
Dim headerMap As Object


VBA Code:
'Define the columns you want to copy
Dim column1 As String
'Set the column header names in the source workbook
column1 = "Date"


VBA Code:
'Find the row number of the column header names in the source workbook
Dim column1Row As Integer
column1Row = 20


VBA Code:
Dim i As Integer

This next block of code is looping through the rows in the "sourceWorkbook" sheet and searching for the header named "column1". When it finds the header, it sets the value of "column1Row" to the row number and exits the loop. The purpose of this code is to determine the row number of the header so that the data can be copied starting from the row after the header.

VBA Code:
For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 2) = column1 Then
column1Row = i
Exit For
End If
Next i



VBA Code:
'Define a dictionary to store the mapping of header names
Set headerMap = CreateObject("Scripting.Dictionary")



VBA Code:
'Map the header names between the source and target workbooks
headerMap("Date") = "For Month (YYYY MM)"


the merge cells started at row 3,

VBA Code:
'Find the row number of the target headers
Dim targetHeader1Row As Integer
targetHeader1Row = 3

The next block iterates through each row in the first sheet of the targetWorkbook. The purpose of the loop is to find the row number in the targetWorkbook where the value in column 4 matches the headerMap(column1). The headerMap is a dictionary that maps the column headers in the source workbook to the column headers in the target workbook. The headerMap(column1) is the target header name corresponding to the source header name stored in the variable column1.

The loop checks each row in the targetWorkbook's first sheet and if the value in column 4 of that row matches the headerMap(column1), it assigns the row number to the variable targetHeader1Row and exits the loop using the Exit For statement. This is done to find the row number of the target header so that data can be copied to the correct row in the target workbook.

VBA Code:
For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 4) = headerMap(column1) Then
targetHeader1Row = i
Exit For
End If
Next i


The target workbook headers' cell are merged cell of 2 consecutive rows of (D3 and D4), hence, targetheader1row+1 = (3+1) => row 3 and 4 to get them.

VBA Code:
'Find the end row of the merged cells in the target workbook
Dim targetHeader1EndRow As Integer
targetHeader1EndRow = targetHeader1Row + 1



The range being copied is defined as the range between two cells:

the starting cell (targetWorkbook.Sheets(1).Cells(targetHeader1Row, 4)) and the ending cell (targetWorkbook.Sheets(1).Cells(targetHeader1EndRow, 12)).

These two cells define the rectangular range of cells that will be copied from the source workbook to the target workbook.

The range in the source workbook is defined as

sourceWorkbook.Sheets(1).Range(sourceWorkbook.Sheets(1).Cells(column, 2), sourceWorkbook.Sheets(1).Cells(column, headerMap(header1))).

This is the range that will be copied to the target workbook.

The line of code uses the .Value property to copy the values of the cells in the range defined in the source workbook to the range defined in the target workbook.

VBA Code:
'Copy the data to the target workbook
targetWorkbook.Sheets(1).Range(targetWorkbook.Sheets(1).Cells(targetHeader1EndRow,4),targetWorkbook.Sheets(1).Cells(targetHeader9EndRow,12)).Value=sourceWorkbook.Sheets(1).Range(sourceWorkbook.Sheets(1).Cells(column1Row,2),sourceWorkbook.Sheets(1).Cells(column9Row,10)).Value
 
Upvote 0
Here's the full updated code.

I am not reciving any runtime error anymore, though it still doesnt copy/paste anything from the sourcebook to the targetbook.
VBA Code:
Option Explicit

Sub CopyData()

Dim sourceWorkbook As Workbook
Dim targetWorkbook As Workbook
Dim headerMap As Object

'Open the source workbook
Set sourceWorkbook = Workbooks.Open("C:\Users\User\Desktop\Trial 1\Sourcebook1.xlsx")

'Open the target workbook
Set targetWorkbook = Workbooks.Open("C:\Users\User\Desktop\Trial 1\Targetbook1.xlsx")

'Define the columns you want to copy
Dim column1 As String
Dim column2 As String
Dim column3 As String
Dim column4 As String
Dim column5 As String
Dim column6 As String
Dim column7 As String
Dim column8 As String
Dim column9 As String

'Set the column header names in the source workbook
column1 = "Date"
column2 = "Comments at Order Time"
column3 = "Comments on iPad"
column4 = "Name of signee"
column5 = "Location"
column6 = "Date"
column7 = "DO No."
column8 = "Product Description"
column9 = "DO Qty"

'Find the row number of the column header names in the source workbook
Dim column1Row As Integer
Dim column2Row As Integer
Dim column3Row As Integer
Dim column4Row As Integer
Dim column5Row As Integer
Dim column6Row As Integer
Dim column7Row As Integer
Dim column8Row As Integer
Dim column9Row As Integer

column1Row = 20
column2Row = 20
column3Row = 20
column4Row = 20
column5Row = 20
column6Row = 20
column7Row = 20
column8Row = 20
column9Row = 20

Dim i As Integer

For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 2) = column1 Then
column1Row = i
Exit For
End If
Next i


For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 3) = column2 Then
column2Row = i
Exit For
End If
Next i


For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 4) = column3 Then
column3Row = i
Exit For
End If
Next i



For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 5) = column4 Then
column4Row = i
Exit For
End If
Next i



For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 6) = column5 Then
column5Row = i
Exit For
End If
Next i



For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 7) = column6 Then
column6Row = i
Exit For
End If
Next i



For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 8) = column7 Then
column7Row = i
Exit For
End If
Next i



For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 9) = column8 Then
column8Row = i
Exit For
End If
Next i



For i = 1 To sourceWorkbook.Sheets(1).UsedRange.Rows.Count
If sourceWorkbook.Sheets(1).Cells(i, 10) = column9 Then
column9Row = i
Exit For
End If
Next i


'Define a dictionary to store the mapping of header names

Set headerMap = CreateObject("Scripting.Dictionary")

'Map the header names between the source and target workbooks
headerMap("Date") = "For Month (YYYY MM)"
headerMap("Comments at Order Time") = "Comments at Order Time"
headerMap("Comments on iPad") = "Comments on iPad"
headerMap("Name of signee") = "Name of signee"
headerMap("Location") = "For TAK or Subcon? [HSUENCHOW/Pintary/ BBR/ KKL..etc]"
headerMap("Date") = "Date"
headerMap("DO No.") = "DO No."
headerMap("Product Description") = "1"
headerMap("DO Qty") = "Qty"


'Find the row number of the target headers
Dim targetHeader1Row As Integer
Dim targetHeader2Row As Integer
Dim targetHeader3Row As Integer
Dim targetHeader4Row As Integer
Dim targetHeader5Row As Integer
Dim targetHeader6Row As Integer
Dim targetHeader7Row As Integer
Dim targetHeader8Row As Integer
Dim targetHeader9Row As Integer

targetHeader1Row = 3
targetHeader2Row = 3
targetHeader3Row = 3
targetHeader4Row = 3
targetHeader5Row = 3
targetHeader6Row = 3
targetHeader7Row = 3
targetHeader8Row = 3
targetHeader9Row = 3


For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 4) = headerMap(column1) Then
targetHeader1Row = i
Exit For
End If
Next i



For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 5) = headerMap(column2) Then
targetHeader2Row = i
Exit For
End If
Next i



For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 6) = headerMap(column3) Then
targetHeader3Row = i
Exit For
End If
Next i



For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 7) = headerMap(column4) Then
targetHeader4Row = i
Exit For
End If
Next i



For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 8) = headerMap(column5) Then
targetHeader5Row = i
Exit For
End If
Next i



For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 9) = headerMap(column6) Then
targetHeader6Row = i
Exit For
End If
Next i



For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 10) = headerMap(column7) Then
targetHeader7Row = i
Exit For
End If
Next i



For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 11) = headerMap(column8) Then
targetHeader8Row = i
Exit For
End If
Next i


For i = 1 To targetWorkbook.Sheets(1).UsedRange.Rows.Count
If targetWorkbook.Sheets(1).Cells(i, 12) = headerMap(column9) Then
targetHeader9Row = i
Exit For
End If
Next i


'Find the end row of the merged cells in the target workbook
Dim targetHeader1EndRow As Integer
Dim targetHeader2EndRow As Integer
Dim targetHeader3EndRow As Integer
Dim targetHeader4EndRow As Integer
Dim targetHeader5EndRow As Integer
Dim targetHeader6EndRow As Integer
Dim targetHeader7EndRow As Integer
Dim targetHeader8EndRow As Integer
Dim targetHeader9EndRow As Integer


targetHeader1EndRow = targetHeader1Row + 1
targetHeader2EndRow = targetHeader2Row + 1
targetHeader3EndRow = targetHeader3Row + 1
targetHeader4EndRow = targetHeader4Row + 1
targetHeader5EndRow = targetHeader5Row + 1
targetHeader6EndRow = targetHeader6Row + 1
targetHeader7EndRow = targetHeader7Row + 1
targetHeader8EndRow = targetHeader8Row + 1
targetHeader9EndRow = targetHeader9Row + 1

'Copy the data to the target workbook
targetWorkbook.Sheets(1).Range(targetWorkbook.Sheets(1).Cells(targetHeader1EndRow,4),targetWorkbook.Sheets(1).Cells(targetHeader9EndRow,12)).Value=sourceWorkbook.Sheets(1).Range(sourceWorkbook.Sheets(1).Cells(column1Row,2),sourceWorkbook.Sheets(1).Cells(column9Row,10)).Value




'Save and close the workbooks
sourceWorkbook.Close savechanges:=False


End Sub
 
Upvote 0
Are the headers in the two workbooks not always on the same row? If they are always on the same row, what are the row numbers? In the source workbook, you have two columns headers (B and G) named as "Date". Which of the two columns do you want to copy to the target workbook? In the source workbook, column J is named "DO Qty" but the target workbook, column L is named "Qty". If you want "DO Qty" to be copied to "Qty", it would make it easier if you can change "Qty" to "DO Qty" or vice versa.
 
Upvote 0
Are the headers in the two workbooks not always on the same row? If they are always on the same row, what are the row numbers? In the source workbook, you have two columns headers (B and G) named as "Date". Which of the two columns do you want to copy to the target workbook? In the source workbook, column J is named "DO Qty" but the target workbook, column L is named "Qty". If you want "DO Qty" to be copied to "Qty", it would make it easier if you can change "Qty" to "DO Qty" or vice versa.
(Sorry, my replies will be delayed as I'm from Singapore, currently is midnight now in SG. I will reply you again in the morning.
Replying part by part:
Are the headers in the two workbooks not always on the same row? If they are always on the same row, what are the row numbers?
No, the headers are not the same row, neither are the columns. I am giving example of the source and target books in simplification. The actual workbooks are more than hundreds of them and even messier (confidential too), hence, I didn't use the real excel workbooks to show in here.

In the source workbook, you have two columns headers (B and G) named as "Date". Which of the two columns do you want to copy to the target workbook?
Column B.

copying cell B21 integer (123.00) from Sourcebook1 into cell D5 of targetbook1.

'Map the header names between the source and target workbooks
headerMap("Date") = "For Month (YYYY MM)"

Hmmm, could this be the error ?? both header with the same name confuses the module?

In the source workbook, column J is named "DO Qty" but the target workbook, column L is named "Qty". If you want "DO Qty" to be copied to "Qty", it would make it easier if you can change "Qty" to "DO Qty" or vice versa.
I am unable to change them as they are the original headers stated in the real excel workbooks with which I'm working.
 
Upvote 0
Place this macro in the source workbook.
VBA Code:
Sub CopyData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, fRowS As Long, fRowT As Long, fColS As Long, fColT As Long, cnt As Long
    Dim v As Variant, i As Long, header1 As Range, header2 As Range
    Set srcWS = ThisWorkbook.Sheets(1)
    Set desWS = Workbooks("Targetbook1").Sheets(1)
    With srcWS
        fRowS = .UsedRange.Find("Date", LookIn:=xlValues, lookat:=xlWhole).Row
        cnt = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - fRowS
        fColS = .UsedRange.Find("Date", LookIn:=xlValues, lookat:=xlWhole).Column
        v = Array("Comments at Order Time", "Comments on iPad", "Name of signee", "DO No.", "Qty")
    End With
    With desWS
        fRowT = .UsedRange.Find("For Month (YYYY MM)", LookIn:=xlValues, lookat:=xlWhole).Row + 2
        fColT = .UsedRange.Find("For Month (YYYY MM)", LookIn:=xlValues, lookat:=xlWhole).Column
        .Cells(fRowT, fColT).Resize(cnt).Value = srcWS.Cells(fRowS + 1, fColS).Resize(cnt).Value
        For i = LBound(v) To UBound(v)
            Set header1 = srcWS.Rows(fRowS).Find(v(i), LookIn:=xlValues, lookat:=xlPart)
            Set header2 = .Rows(fRowT - 2 & ":" & fRowT - 1).Find(v(i), LookIn:=xlValues, lookat:=xlPart)
            .Cells(fRowT, header2.Column).Resize(cnt).Value = srcWS.Cells(fRowS + 1, header1.Column).Resize(cnt).Value
        Next i
    End With
    Application.ScreenUpdating = True
End Sub
You should be aware that in future, you should avoid merging cells if at all possible, because they almost always cause problems for macros.
 
Upvote 0
Place this macro in the source workbook.
VBA Code:
Sub CopyData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, fRowS As Long, fRowT As Long, fColS As Long, fColT As Long, cnt As Long
    Dim v As Variant, i As Long, header1 As Range, header2 As Range
    Set srcWS = ThisWorkbook.Sheets(1)
    Set desWS = Workbooks("Targetbook1").Sheets(1)
    With srcWS
        fRowS = .UsedRange.Find("Date", LookIn:=xlValues, lookat:=xlWhole).Row
        cnt = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - fRowS
        fColS = .UsedRange.Find("Date", LookIn:=xlValues, lookat:=xlWhole).Column
        v = Array("Comments at Order Time", "Comments on iPad", "Name of signee", "DO No.", "Qty")
    End With
    With desWS
        fRowT = .UsedRange.Find("For Month (YYYY MM)", LookIn:=xlValues, lookat:=xlWhole).Row + 2
        fColT = .UsedRange.Find("For Month (YYYY MM)", LookIn:=xlValues, lookat:=xlWhole).Column
        .Cells(fRowT, fColT).Resize(cnt).Value = srcWS.Cells(fRowS + 1, fColS).Resize(cnt).Value
        For i = LBound(v) To UBound(v)
            Set header1 = srcWS.Rows(fRowS).Find(v(i), LookIn:=xlValues, lookat:=xlPart)
            Set header2 = .Rows(fRowT - 2 & ":" & fRowT - 1).Find(v(i), LookIn:=xlValues, lookat:=xlPart)
            .Cells(fRowT, header2.Column).Resize(cnt).Value = srcWS.Cells(fRowS + 1, header1.Column).Resize(cnt).Value
        Next i
    End With
    Application.ScreenUpdating = True
End Sub
You should be aware that in future, you should avoid merging cells if at all possible, because they almost always cause problems for macros.
Morning from Singapore!

Thank you for your contribution and help. However, I have edited to included all column to be copied from source to targetbook, yet, the copying/pasting stops at Column F of Source or Column H of Target (as shown).

VBA Code:
Sub CopyData()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, fRowS As Long, fRowT As Long, fColS As Long, fColT As Long, cnt As Long
    Dim v As Variant, i As Long, header1 As Range, header2 As Range
    Set srcWS = ThisWorkbook.Sheets(1)
    Set desWS = Workbooks("Targetbook1").Sheets(1)
    With srcWS
        fRowS = .UsedRange.Find("Date", LookIn:=xlValues, lookat:=xlWhole).Row
        cnt = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - fRowS
        fColS = .UsedRange.Find("Date", LookIn:=xlValues, lookat:=xlWhole).Column
        v = Array("Comments at Order Time", "Comments on iPad", "Name of signee", "For TAK or Subcon? [HSUENCHOW/Pintary/ BBR/ KKL..etc]", "Date", "DO No.", "1", "Qty")
    End With
    With desWS
        fRowT = .UsedRange.Find("For Month (YYYY MM)", LookIn:=xlValues, lookat:=xlWhole).Row + 2
        fColT = .UsedRange.Find("For Month (YYYY MM)", LookIn:=xlValues, lookat:=xlWhole).Column
        .Cells(fRowT, fColT).Resize(cnt).Value = srcWS.Cells(fRowS + 1, fColS).Resize(cnt).Value
        For i = LBound(v) To UBound(v)
            Set header1 = srcWS.Rows(fRowS).Find(v(i), LookIn:=xlValues, lookat:=xlPart)
            Set header2 = .Rows(fRowT - 2 & ":" & fRowT - 1).Find(v(i), LookIn:=xlValues, lookat:=xlPart)
            .Cells(fRowT, header2.Column).Resize(cnt).Value = srcWS.Cells(fRowS + 1, header1.Column).Resize(cnt).Value
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

1675730437519.png
 
Upvote 0
Due to the inconsistency of the headers in both workbooks, the approach I suggested won't work. The only way that I can see that it will work is if the number of columns in both workbooks is always the same and that the columns in both workbooks are always in the same order. In other words, the first column of data from the source will be copied to the first column in the target, the second column from source to the second column of target, the third column to the third column, etc.
 
Upvote 0

Forum statistics

Threads
1,223,952
Messages
6,175,596
Members
452,657
Latest member
giadungthienduyen

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