如何将人员数据移动到与VBA链接的工作表中



我有一张表格,里面有一些虚构的个人数据:电话号码、地址等。我有大约 200 个不同的人,所以我制作了一个 vba,可以根据人名自动创建工作表。而且我和vba相当陌生,并且知道如何复制数据,例如使用..

Sheets("Ark1").Range("A1:O10").Copy Destination:=Sheets("Ark2").Range("A1")

但这仅考虑该特定工作表目标。我如何根据工作表("Ark1"(中的名字。从"Ark1"中移动属于特定人员的数据。如链接图像所示,B列是一个人的数据,C列是另一个人的数据,依此类推。搜索条件应该是他们的名字,这就是我将不同工作表定义为的名称,他们的名字在数据文件"Ark1"的"row2"中。

更新后的数据集

我很难理解你需要做什么。您根据 row2 中的名称手动创建了工作表,还是仍然需要制作它们?现在您想将工作表(1(中的所有信息复制到ark1工作表中吗?还有什么是工作表(1(?亨里克·詹森斯表?您的屏幕截图暗示您想要来自方舟表的信息,但您的代码暗示您将 COPY 到 ark1 表。

我最好的猜测是,根据需要进行调整:

Sub test()
'See how many columns you have on your sheet (I'm assuming your Ark1 sheet has the input)
For i = 2 To ThisWorkbook.Sheets("Ark1").Cells(2, Columns.Count).End(xlToLeft).Column
'This creates new sheets with the names from the second row (was this done already?)
ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = _
ThisWorkbook.Sheets("Ark1").Cells(2, i)
'Pick one of the next three, depending on what you need
'1.) This is where I'm confused but you should be able to adjust this as needed.
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Ark1").Cells(2, i).Value).Range("A1:O10").Value = _
ThisWorkbook.Sheets("Sheet1").Range("A1:O10").Value 'I dont see a sheet1 in your screenshot but your code has it This is the source tho
'2.) Maybe you mean this tho?
ThisWorkbook.Sheets(ThisWorkbook.Sheets("Ark1").Cells(2, i).Value).Columns(1).Value = _
ThisWorkbook.Sheets("Ark1").Columns(i).Value
'3.) if you need to copy
ThisWorkbook.Sheets("Ark1").Columns(i).Copy _
Destination:=ThisWorkbook.Sheets(ThisWorkbook.Sheets("Ark1").Cells(2, i).Value).Columns(1)
Next
End Sub

这也将中断第 2 行中的相同名称和空单元格,根据需要创建处理程序。否则应该工作吗?不确定是否需要 .value。

最新更新