将数据从一个 sheet 复制到具有相同列名（不一定相同顺序）的另一个（同一工作簿）
Copy data from one sheet to another (same workbook) with same column names (not necessarily same order)
我有两列 Data 和 Data1，工作sheet 名为“Data”。我在 sheet 上有相同的列名，名为“MasterData”。我想阅读“Data”worksheet 上的内容，并根据列名 (Data & Data1) 复制到“MasterData”。另外，假设我有 10 个数据点复制到“MasterData”，下次我想将该数据保留在那里，但将新数据从 sheet“Data”复制到“MasterData”，通过检查特定列中的第一个空单元格（在本例中为单元格编号 11）。这需要继续进行，因为“MasterData”将存储所有历史数据。
Sub CopyDatatoMasterData2()
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("C2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
Range("C" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("D2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "D").End(xlUp).Row
Range("D" & lMaxRows + 1).Select
ActiveSheet.Paste
Range("E2").Select
Sheets("Data").Select
Range("E2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "E").End(xlUp).Row
Range("E" & lMaxRows + 1).Select
ActiveSheet.Paste
Range("F2").Select
Sheets("Data").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "F").End(xlUp).Row
Range("F" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("G2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "G").End(xlUp).Row
Range("G" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("H2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "H").End(xlUp).Row
Range("H" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("I2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "I").End(xlUp).Row
Range("I" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("J2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "J").End(xlUp).Row
Range("J" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("K2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "K").End(xlUp).Row
Range("K" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("L2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "L").End(xlUp).Row
Range("L" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("M2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "M").End(xlUp).Row
Range("M" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("N2:N3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "N").End(xlUp).Row
Range("N" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("O2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "O").End(xlUp).Row
Range("O" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("P2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "P").End(xlUp).Row
Range("P" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("Q2:Q3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "Q").End(xlUp).Row
Range("Q" & lMaxRows + 1).Select
ActiveSheet.Paste
End Sub
这不是 Stack Overflow 的好问题。该站点供程序员互相帮助开发。你的问题是这样写的：“我想要一个宏来做这个。写给我看。”不是一种流行的提问方式。
在此页面的右上角，您会找到一个“帮助”按钮。你会发现它背后有很多好的但一般的建议。在这个回答中我会尝试给出更具体的建议。
您必须学习 VBA 的基础知识。你可以用很少的知识自己回答这个问题。花在学习上的几个小时很快就会得到回报。在网络上搜索“Excel VBA 教程”。有很多可供选择。尝试几个并完成最接近您的学习风格的那个。我更喜欢书。我参观了一个很好的图书馆；审查了他们的 Excel VBA 引物；借了最有希望的回家试试再买我认为最好的作为永久参考书。
此站点不适合提出设计问题。您需要将您的要求分解为小步骤。这里有很多问题和答案可以解决您的总体要求的各个步骤，但据我所知，没有一个符合您的完整要求。
你通常可以通过思考如何手动解决这个问题来创建一个简单的设计：
- 在主工作表的数据列中找到最后使用的单元格。调用最后使用的单元格下方的单元格：Target.
- 在工作表数据的数据列中找到最后使用的单元格。
- Select 从第一个数据单元格到最后一个单元格。
- 将 selection 复制到目标单元格。
- 对 Data1 列重复上述步骤。
有 VBA 语句等同于步骤 1 到 4。您可以 select 并将其作为单独的步骤复制到 VBA 中，但这不是好的做法；有一个 VBA 语句将它们组合起来更快更整洁。
有几个 VBA 语句允许您重复（循环）具有不同参数的代码块以获得略有不同的效果。
是不是看起来更容易了？我们有一系列简单的步骤，而不是模糊的描述。我希望任何教程都能在前几页中解释如何执行这些步骤。在我的代码中，我使用了一些教程开头可能没有的技术。我解释了为什么我使用它们。有关额外信息，请搜索“Excel VBA 函数数组”或“Excel VBA 常量”或类似内容。如果有必要，可以带着问题回来，但是你自己发现的越多，你的发展就会越快。
欢迎来到编程的乐趣。
Option Explicit
' * I have a system of naming my variabls that I have used for years. I can
' look at macros I wrote years ago and immediately know what all the
' variables. I am not asking you to like my system but to develop your own
' system.
' * My naming system using a sequence of words that get more and precise
' until I have a unique name. The first word what the variable is being
' used for. "Col" means its associated with columns of a worksheet or a
' two-dimensional array. If I have multiple worksheets and/or arrays, the
' next word identifies whch worksheet or array. If I have multiple
' columns, the next word identifies which column.
' * Constants make code easier to read and easiest to maintain. Instead of a
' literal, such as 2, you have a meaningful name, ColDataData. Columns
' can be identified by code or number: A=1, B=2, C=3 and so on. I have used
' numbers which I normally find more convenient although I could have used
' codes here.
Const ColDataData As Long = 2
Const ColDataData1 As Long = 4
Const ColMasterData As Long = 1
Const ColMasterData1 As Long = 2
Const RowDataFirstData As Long = 2 ' Adjust according to how many header
' rows you have in worksheet "Data"
Sub AddToMasterColumn()
Dim ColDataCrnt As Long
Dim ColMasterCrnt As Long
Dim ColsData() As Variant
Dim ColsMaster() As Variant
Dim InxCols As Long
Dim Rng As Range
Dim RowDataLast As Long
Dim RowMasterTgt As Long
Dim WshtData As Worksheet
Dim WshtMaster As Worksheet
' * Processing for your two sets of columns is the same so we can use a loop
' with parameters so says which pair of columns each loop is to handle.
' * Array() is a convenient way to load an array although the array must be
' variant. Since I am loading different data types (String and Long) to
' the same array, this is required anyway.
' * These two arrays MUST have the same number of elements.
ColsData = Array(ColDataData, ColDataData1)
ColsMaster = Array(ColMasterData, ColMasterData1)
' Debug.Assert is a convenient way of testing for program errors during
' development. If UBound(ColsData) and UBound(ColsMaster) are not equal,
' execution will stop here.
Debug.Assert UBound(ColsData) = UBound(ColsMaster)
' I could have used Worksheets("Data") where ever I use WshtData below.
' Using WshtData is slightly faster and, in my view, neater. If you change
' names of one of the worksheets, one change here will fix the macro.
Set WshtData = Worksheets("Data")
Set WshtMaster = Worksheets("MasterData")
For InxCols = LBound(ColsData) To UBound(ColsData)
With WshtMaster
' Get the destination column in worksheet Master for the current loop
ColMasterCrnt = ColsMaster(InxCols)
' Find the last used row in ColMasterCrnt and add one to it to get the target cell
RowMasterTgt = .Cells(Rows.Count, ColMasterCrnt).End(xlUp).Row + 1
End With
With WshtData
' Get the source column in worksheet data for the current loop
ColDataCrnt = ColsData(InxCols)
' Find the last used row in ColDataCrnt
RowDataLast = .Cells(Rows.Count, ColDataCrnt).End(xlUp).Row
' Specify the range to be copied
Set Rng = .Range(.Cells(RowDataFirstData, ColDataCrnt), .Cells(RowDataLast, ColDataCrnt))
End With
' Copy data
Rng.Copy Destination:=WshtMaster.Cells(RowMasterTgt, ColMasterCrnt)
Next
End Sub
因应额外需求而增加
我相信 Function FindColumnByName() 可以满足您的所有需求。如果需要，我可以提供更复杂的变体。例如，我有一个搜索 multi-row 标题的变体。但是让我们从简单的开始。
您需要删除：
Const ColDataData As Long = 2
Const ColDataData1 As Long = 4
Const ColMasterData As Long = 1
Const ColMasterData1 As Long = 2
并在 AddToMasterColumn 的顶部添加：
Dim ColDataData As Long:
Dim ColDataData1 As Long
Dim ColMasterData As Long
Dim ColMasterData1 As Long
并在设置WshtData和WshtMaster后添加：
ColDataData = FindColumnByName(WshtData, “Data”)
ColDataData1 = FindColumnByName(WshtData, “Data1”)
ColMasterData = FindColumnByName(WshtMaster, “Data”)
ColMasterData1 = FindColumnByName(WshtMaster, “Data2”)
测试例程 TestFCBN 展示了在您开发的这个阶段可能有用或可能造成混淆的技术。快速浏览一下，但如果您难以理解，请先忽略它。在我的测试工作表中，它输出：
Column 2 of worksheet Data is named Data
Column 4 of worksheet Data is named Data1
There is no column named X in worksheet Data
Column 1 of worksheet MasterData is named Data
Column 2 of worksheet MasterData is named Data1
新代码：
Sub TestFCBN()
Dim ColName As String
Dim ColTgt As Long
Dim InxTV As Long
Dim TestValues As Variant
Dim WshtName As String
TestValues = Array("Data", "Data", "Data", "Data1", "Data", "X", _
"MasterData", "Data", "MasterData", "Data1")
' There must be an even number of values in TestValues. The first of each
' pair is the name of a worksheet, the second the name of a column in that
' worksheet.
For InxTV = LBound(TestValues) To UBound(TestValues) Step 2
WshtName = TestValues(InxTV)
ColName = TestValues(InxTV + 1)
ColTgt = FindColumnByName(Worksheets(WshtName), ColName)
If ColTgt = 0 Then
Debug.Print "There is no column named " & ColName & " in worksheet " & WshtName
Else
Debug.Print "Column " & ColTgt & " of worksheet " & WshtName & _
" is named " & ColName
End If
Next
End Sub
Function FindColumnByName(Wsht As Worksheet, ColName As String) As Long
' This function scans row 1 for a cell with a value of ColName.
' If found, it returns the number of that column.
' If not found, it returns 0
Dim ColCrnt As Long
Dim ColLast As Long
With Wsht
ColLast = .Cells(1, Columns.Count).End(xlToLeft).Column
For ColCrnt = 1 To ColLast
If .Cells(1, ColCrnt).Value = ColName Then
FindColumnByName = ColCrnt
Exit Function
End If
Next
End With
FindColumnByName = 0
End Function
我有两列 Data 和 Data1，工作sheet 名为“Data”。我在 sheet 上有相同的列名，名为“MasterData”。我想阅读“Data”worksheet 上的内容，并根据列名 (Data & Data1) 复制到“MasterData”。另外，假设我有 10 个数据点复制到“MasterData”，下次我想将该数据保留在那里，但将新数据从 sheet“Data”复制到“MasterData”，通过检查特定列中的第一个空单元格（在本例中为单元格编号 11）。这需要继续进行，因为“MasterData”将存储所有历史数据。
Sub CopyDatatoMasterData2()
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("C2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
Range("C" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("D2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "D").End(xlUp).Row
Range("D" & lMaxRows + 1).Select
ActiveSheet.Paste
Range("E2").Select
Sheets("Data").Select
Range("E2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "E").End(xlUp).Row
Range("E" & lMaxRows + 1).Select
ActiveSheet.Paste
Range("F2").Select
Sheets("Data").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "F").End(xlUp).Row
Range("F" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("G2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "G").End(xlUp).Row
Range("G" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("H2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "H").End(xlUp).Row
Range("H" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("I2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "I").End(xlUp).Row
Range("I" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("J2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "J").End(xlUp).Row
Range("J" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("K2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "K").End(xlUp).Row
Range("K" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("L2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "L").End(xlUp).Row
Range("L" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("M2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "M").End(xlUp).Row
Range("M" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("N2:N3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "N").End(xlUp).Row
Range("N" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("O2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "O").End(xlUp).Row
Range("O" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("P2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "P").End(xlUp).Row
Range("P" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Data").Select
Range("Q2:Q3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MasterData").Select
lMaxRows = Cells(Rows.Count, "Q").End(xlUp).Row
Range("Q" & lMaxRows + 1).Select
ActiveSheet.Paste
End Sub
这不是 Stack Overflow 的好问题。该站点供程序员互相帮助开发。你的问题是这样写的：“我想要一个宏来做这个。写给我看。”不是一种流行的提问方式。
在此页面的右上角，您会找到一个“帮助”按钮。你会发现它背后有很多好的但一般的建议。在这个回答中我会尝试给出更具体的建议。
您必须学习 VBA 的基础知识。你可以用很少的知识自己回答这个问题。花在学习上的几个小时很快就会得到回报。在网络上搜索“Excel VBA 教程”。有很多可供选择。尝试几个并完成最接近您的学习风格的那个。我更喜欢书。我参观了一个很好的图书馆；审查了他们的 Excel VBA 引物；借了最有希望的回家试试再买我认为最好的作为永久参考书。
此站点不适合提出设计问题。您需要将您的要求分解为小步骤。这里有很多问题和答案可以解决您的总体要求的各个步骤，但据我所知，没有一个符合您的完整要求。
你通常可以通过思考如何手动解决这个问题来创建一个简单的设计：
- 在主工作表的数据列中找到最后使用的单元格。调用最后使用的单元格下方的单元格：Target.
- 在工作表数据的数据列中找到最后使用的单元格。
- Select 从第一个数据单元格到最后一个单元格。
- 将 selection 复制到目标单元格。
- 对 Data1 列重复上述步骤。
有 VBA 语句等同于步骤 1 到 4。您可以 select 并将其作为单独的步骤复制到 VBA 中，但这不是好的做法；有一个 VBA 语句将它们组合起来更快更整洁。
有几个 VBA 语句允许您重复（循环）具有不同参数的代码块以获得略有不同的效果。
是不是看起来更容易了？我们有一系列简单的步骤，而不是模糊的描述。我希望任何教程都能在前几页中解释如何执行这些步骤。在我的代码中，我使用了一些教程开头可能没有的技术。我解释了为什么我使用它们。有关额外信息，请搜索“Excel VBA 函数数组”或“Excel VBA 常量”或类似内容。如果有必要，可以带着问题回来，但是你自己发现的越多，你的发展就会越快。
欢迎来到编程的乐趣。
Option Explicit
' * I have a system of naming my variabls that I have used for years. I can
' look at macros I wrote years ago and immediately know what all the
' variables. I am not asking you to like my system but to develop your own
' system.
' * My naming system using a sequence of words that get more and precise
' until I have a unique name. The first word what the variable is being
' used for. "Col" means its associated with columns of a worksheet or a
' two-dimensional array. If I have multiple worksheets and/or arrays, the
' next word identifies whch worksheet or array. If I have multiple
' columns, the next word identifies which column.
' * Constants make code easier to read and easiest to maintain. Instead of a
' literal, such as 2, you have a meaningful name, ColDataData. Columns
' can be identified by code or number: A=1, B=2, C=3 and so on. I have used
' numbers which I normally find more convenient although I could have used
' codes here.
Const ColDataData As Long = 2
Const ColDataData1 As Long = 4
Const ColMasterData As Long = 1
Const ColMasterData1 As Long = 2
Const RowDataFirstData As Long = 2 ' Adjust according to how many header
' rows you have in worksheet "Data"
Sub AddToMasterColumn()
Dim ColDataCrnt As Long
Dim ColMasterCrnt As Long
Dim ColsData() As Variant
Dim ColsMaster() As Variant
Dim InxCols As Long
Dim Rng As Range
Dim RowDataLast As Long
Dim RowMasterTgt As Long
Dim WshtData As Worksheet
Dim WshtMaster As Worksheet
' * Processing for your two sets of columns is the same so we can use a loop
' with parameters so says which pair of columns each loop is to handle.
' * Array() is a convenient way to load an array although the array must be
' variant. Since I am loading different data types (String and Long) to
' the same array, this is required anyway.
' * These two arrays MUST have the same number of elements.
ColsData = Array(ColDataData, ColDataData1)
ColsMaster = Array(ColMasterData, ColMasterData1)
' Debug.Assert is a convenient way of testing for program errors during
' development. If UBound(ColsData) and UBound(ColsMaster) are not equal,
' execution will stop here.
Debug.Assert UBound(ColsData) = UBound(ColsMaster)
' I could have used Worksheets("Data") where ever I use WshtData below.
' Using WshtData is slightly faster and, in my view, neater. If you change
' names of one of the worksheets, one change here will fix the macro.
Set WshtData = Worksheets("Data")
Set WshtMaster = Worksheets("MasterData")
For InxCols = LBound(ColsData) To UBound(ColsData)
With WshtMaster
' Get the destination column in worksheet Master for the current loop
ColMasterCrnt = ColsMaster(InxCols)
' Find the last used row in ColMasterCrnt and add one to it to get the target cell
RowMasterTgt = .Cells(Rows.Count, ColMasterCrnt).End(xlUp).Row + 1
End With
With WshtData
' Get the source column in worksheet data for the current loop
ColDataCrnt = ColsData(InxCols)
' Find the last used row in ColDataCrnt
RowDataLast = .Cells(Rows.Count, ColDataCrnt).End(xlUp).Row
' Specify the range to be copied
Set Rng = .Range(.Cells(RowDataFirstData, ColDataCrnt), .Cells(RowDataLast, ColDataCrnt))
End With
' Copy data
Rng.Copy Destination:=WshtMaster.Cells(RowMasterTgt, ColMasterCrnt)
Next
End Sub
因应额外需求而增加
我相信 Function FindColumnByName() 可以满足您的所有需求。如果需要，我可以提供更复杂的变体。例如，我有一个搜索 multi-row 标题的变体。但是让我们从简单的开始。
您需要删除：
Const ColDataData As Long = 2
Const ColDataData1 As Long = 4
Const ColMasterData As Long = 1
Const ColMasterData1 As Long = 2
并在 AddToMasterColumn 的顶部添加：
Dim ColDataData As Long:
Dim ColDataData1 As Long
Dim ColMasterData As Long
Dim ColMasterData1 As Long
并在设置WshtData和WshtMaster后添加：
ColDataData = FindColumnByName(WshtData, “Data”)
ColDataData1 = FindColumnByName(WshtData, “Data1”)
ColMasterData = FindColumnByName(WshtMaster, “Data”)
ColMasterData1 = FindColumnByName(WshtMaster, “Data2”)
测试例程 TestFCBN 展示了在您开发的这个阶段可能有用或可能造成混淆的技术。快速浏览一下，但如果您难以理解，请先忽略它。在我的测试工作表中，它输出：
Column 2 of worksheet Data is named Data
Column 4 of worksheet Data is named Data1
There is no column named X in worksheet Data
Column 1 of worksheet MasterData is named Data
Column 2 of worksheet MasterData is named Data1
新代码：
Sub TestFCBN()
Dim ColName As String
Dim ColTgt As Long
Dim InxTV As Long
Dim TestValues As Variant
Dim WshtName As String
TestValues = Array("Data", "Data", "Data", "Data1", "Data", "X", _
"MasterData", "Data", "MasterData", "Data1")
' There must be an even number of values in TestValues. The first of each
' pair is the name of a worksheet, the second the name of a column in that
' worksheet.
For InxTV = LBound(TestValues) To UBound(TestValues) Step 2
WshtName = TestValues(InxTV)
ColName = TestValues(InxTV + 1)
ColTgt = FindColumnByName(Worksheets(WshtName), ColName)
If ColTgt = 0 Then
Debug.Print "There is no column named " & ColName & " in worksheet " & WshtName
Else
Debug.Print "Column " & ColTgt & " of worksheet " & WshtName & _
" is named " & ColName
End If
Next
End Sub
Function FindColumnByName(Wsht As Worksheet, ColName As String) As Long
' This function scans row 1 for a cell with a value of ColName.
' If found, it returns the number of that column.
' If not found, it returns 0
Dim ColCrnt As Long
Dim ColLast As Long
With Wsht
ColLast = .Cells(1, Columns.Count).End(xlToLeft).Column
For ColCrnt = 1 To ColLast
If .Cells(1, ColCrnt).Value = ColName Then
FindColumnByName = ColCrnt
Exit Function
End If
Next
End With
FindColumnByName = 0
End Function