VBA为不同格式的数据获取新工作表Excel

Question

我还是VBA EXCEL编程的新手。

我需要以不同格式从一张表格提取数据到另一张表格。但是，许多教程似乎只是按行提取数据行，或者按范围将数据范围提取到新的工作表。

所以这是我DataSheet1：

**School   Principal Student Student ID** 
United College Bill Gates Peter  p3214 
United College Bill Gates Mary  p4213 
United College Bill Gates Forge  p7621 
Beverly High  Melin Brad Goge  p1111 
Beverly High  Melin Brad Fred  p2222 

我想使数据到另一个数据表自定义格式。因此，这里是我想要的结果：

School  United College 
Principal Bill Gates 

Student Student ID 
Peter  p3214 
Mary  p4213 
Forge  p7621 


School  Beverly High 
Principal Melinda Brad 

Student Student ID 
Goge  p1111 
Fred  p2222 

下面是我的一些代码，以获得工作表Sheet1到Sheet2，但代码只显示摆脱范围内的数据范围。应该用于将数据提取到自定义格式中的一些概念是什么？我的代码：

Dim secondsheet As Worksheet 
Set secondsheet = workbook.Worksheets(2) 
Dim firstsheet As Worksheet 
Set firstsheet = workbook.Worksheets(1) 

secondsheet.Range("A1", "C10").Value = firstsheet.Range("A1", "C10").Value 

，格式，我打算把我的数据：

Range(<<call function for range>>).Select 
With Selection 
    .Value = "School" 
    .Offset(1,0).Value = "Principal" 
    .Offset(1,0).Font.Bold = True 
    .Offset(4,1).Value = "Student" 
    .Offset(4,1).Font.Bold = True 
    .Offset(4,2).Value = "Student ID" 
    .Offset(4,2).Font.Bold = True 

所以我要找的是循环的功能，因为它是在这种格式的答案。任何一种灵魂都愿意帮助我理解vba的概念吗？

Answer 1

保留数据在Sheet1并运行宏...小错误就在我的宏..如果妳解决它可以很容易地纠正

col1 = Sheet1.Cells(2, 1) 
prin1 = Sheet1.Cells(2, 2) 
Sheet2.Cells(1, 1) = "School" 
Sheet2.Cells(1, 2) = "Principal" 
Sheet2.Cells(2, 1) = col1 
Sheet2.Cells(2, 2) = prin1 
b = 5 
c = 1 
Sheet2.Cells(b - 1, 1) = "Student" 
Sheet2.Cells(b - 1, 2) = "St ID" 
a = 3 

Do While Sheet1.Cells(a, 1) <> "" 
If col1 = Sheet2.Cells(c + 1, 1) Then 
Sheet2.Cells(b, 1) = Sheet1.Cells(a, 3) 
Sheet2.Cells(b, 2) = Sheet1.Cells(a, 4) 
b = b + 1 
Else 
c = b + 1 
b = c + 3 

col1 = Sheet1.Cells(a, 1) 
prin1 = Sheet1.Cells(a, 2) 
Sheet2.Cells(c, 1) = "School" 
Sheet2.Cells(c, 2) = "Principal" 
Sheet2.Cells(c + 1, 1) = col1 
Sheet2.Cells(c + 1, 2) = prin1 
Sheet2.Cells(b - 1, 1) = "Student" 
Sheet2.Cells(b - 1, 2) = "St ID" 
Sheet2.Cells(b, 1) = Sheet1.Cells(a, 3) 
Sheet2.Cells(b, 2) = Sheet1.Cells(a, 4) 
End If 
a = a + 1 
Loop