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

wo_ofberry · Feb 5, 2023

I am copying data from Sourcebook1 to targetbook1.

Sourcebook1:

Sourcebook1.xlsx

A

B

C

D

E

F

G

H

I

J

K

L

M

1

2

3

4

5

6

7

8

9

10

Sourcebook1

11

12

13

14

15

16

17

18

19

2

3

4

5

6

7

8

9

10

20

Date

Comments at Order Time

Comments on iPad

Name of signee

Location

Date

DO No.

Product Description

DO Qty

21

123.00

132.00

141.00

150.00

159.00

168.00

177.00

186.00

195.00

22

124.00

133.00

142.00

151.00

160.00

169.00

178.00

187.00

196.00

23

125.00

134.00

143.00

152.00

161.00

170.00

179.00

188.00

197.00

24

126.00

135.00

144.00

153.00

162.00

171.00

180.00

189.00

198.00

25

127.00

136.00

145.00

154.00

163.00

172.00

181.00

190.00

199.00

26

128.00

137.00

146.00

155.00

164.00

173.00

182.00

191.00

200.00

27

129.00

138.00

147.00

156.00

165.00

174.00

183.00

192.00

201.00

28

130.00

139.00

148.00

157.00

166.00

175.00

184.00

193.00

202.00

29

131.00

140.00

149.00

158.00

167.00

176.00

185.00

194.00

203.00

30

31

32

Sheet1

targetbook1

Targetbook1.xlsx

A

B

C

D

E

F

G

H

I

J

K

L

M

N

1

Targetbook1

2

4

5

6

7

8

9

10

11

12

3

For Month (YYYY MM)

Comments at Order Time

Comments on iPad

Name of signee

For TAK or Subcon? [HSUENCHOW/Pintary/ BBR/ KKL..etc]

Date

DO No.

1

Qty

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

mumps · Feb 5, 2023

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.

wo_ofberry · Feb 6, 2023

mumps said:
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.

It opens the source and target workbooks using the Workbooks.Open method.
It defines the columns you want to copy using variables such as column1, column2, column3, etc.
It finds the row number of each column header name in the source workbook using a For loop and an If statement.
It creates a dictionary called headerMap to store the mapping of header names between the source and target workbooks.
It finds the row number of the target headers using a similar approach as step 3.
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

wo_ofberry · Feb 6, 2023

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

mumps · Feb 6, 2023

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.

wo_ofberry · Feb 6, 2023

mumps said:
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.

mumps · Feb 6, 2023

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.

wo_ofberry · Feb 6, 2023

mumps said:

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

mumps · Feb 7, 2023

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.

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

wo_ofberry

New Member

Excel Facts

mumps

Well-known Member

wo_ofberry

New Member

wo_ofberry

New Member

mumps

Well-known Member

wo_ofberry

New Member

mumps

Well-known Member

wo_ofberry

New Member

mumps

Well-known Member

Similar threads

Forum statistics

Share this page

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

New Member

Excel Facts

Well-known Member

New Member

New Member

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock