请大神帮帮我，如何把一个工作表中的数据从横向复制到另一个工作表对应竖向的单元格？

心大，舞台大

ykcbf1100 发表于 2024-9-26 10:34
你这个是一个工作簿中的数据向另一个工作簿拆分数据，并不只是纯粹的数据复制那么简单。
问一下，你是要按 ...

老师，我想把工作表中很多行的数据拆分到“打印”工作表，变成很多页跟模板一样的表格，不知道我说明白了没有

Qs18

1. Sub qs()
   
2. Application.ScreenUpdating = False
   
3. Dim arr, i, xb As Workbook, p, rng As Range
   
4. p = ThisWorkbook.Path & "\在校生导出.xlsx"
   
5. Set xb = Workbooks.Open(p, 0)
   
6. arr = xb.Sheets("在校学生列表").UsedRange.Value
   
7. xb.Close (0)
   
8. With Sheet2
   
9. .Range("B7:B10,D7:D10,F7:F10,H7:H10,J7:J10,B14:B17,D14:D17,F14:F17,H14:H17,J14:J17").ClearContents
   
10. Set rng = .Rows("3:18")
    
11. col = 0: rw = 7
    
12. For i = 2 To UBound(arr)
    
13.   If arr(i, 3) <> Empty Then
    
14.     col = col + 2
    
15.     If col > 10 Then
    
16.         col = 2
    
17.         rw = rw + 7
    
18.     End If
    
19.     If rw > 14 Then
    
20.     col = 2: rw = 7
    
21.     r = .Cells(Rows.Count, 1).End(3).Row + 1
    
22.     rng.Copy .Range("a" & r)
    
23.     .Range("B7:B10,D7:D10,F7:F10,H7:H10,J7:J10,B14:B17,D14:D17,F14:F17,H14:H17,J14:J17").ClearContents
    
24.     Application.CutCopyMode = False
    
25.     End If
    
26.     .Cells(rw, col) = arr(i, 1): .Cells(rw + 1, col) = arr(i, 2)
    
27.     .Cells(rw + 2, col) = "'" & arr(i, 4): .Cells(rw + 3, col) = "'" & arr(i, 3)
    
28. End If
    
29. Next
    
30. End With
    
31. Application.ScreenUpdating = True
    
32. End Sub
    

复制代码

Qs18

试试...........

Qs18

试试.............

ykcbf1100

心大，舞台大 发表于 2024-9-26 11:17
老师，我想把工作表中很多行的数据拆分到“打印”工作表，变成很多页跟模板一样的表格，不知道我说明白了 ...

你这求助方式不好，你要在１楼求助时就说清楚，不要到别人写好代码了再来说，大家都很忙，没时间陪你玩。

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$, Arr As Variant, i%, j%, k%, Rst As Object
    Set Cn = CreateObject("Adodb.Connection")
    Set Rst = CreateObject("adodb.recordset")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.Path & "\在校生导出.xlsx"
    StrSQL = "Select 姓名,性别,出生日期,省学籍辅号 From [在校学生列表$]"
    Rst.Open StrSQL, Cn, 1, 3: k = Rst.RecordCount
    For k = 1 To -Int(-(k / 10))
        For j = 1 To 2
            i = 2
            Do While i < 11
                Cells(j * 7, i).Resize(4) = ""
                If Rst.EOF Then
                    Do
                        i = i + 2
                        Cells(j * 7, i).Resize(4) = ""
                    Loop While i < 9
                    GoTo Y
                Else
                    Cells(j * 7, i).Resize(4) = Rst.GetRows(1)
                    i = i + 2
                    If i > 10 Then GoTo X
                End If
            Loop
X:      Next j
Y:      MsgBox "Print*2" 'ActiveSheet.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    Next k
End Sub

limonet

关键字：rst.eof

心大，舞台大

ykcbf1100 发表于 2024-9-26 11:28
你这求助方式不好，你要在１楼求助时就说清楚，不要到别人写好代码了再来说，大家都很忙，没时间陪你玩。 ...

对不起，老师，感谢您

心大，舞台大

Qs18 发表于 2024-9-26 11:26
试试...........

太给力了，谢谢大神，学习中

心大，舞台大

limonet 发表于 2024-9-26 11:46
关键字：rst.eof

万分感谢，有你们真好！