Question

对此很新。需要一些帮助！

我在同一个工作簿中有61个单独的工作表。每个工作表上的第8行都有相同类型的数据，但从列表到表格（从左到右）的列长度不同。

我想编写一个可以执行以下操作的VBA脚本：

从A栏第8行开始。
使用第8行（从左到右）中的数据计算单元格数。
根据计算的细胞数在下面插入行。
将第8行中的数据转置到下面新插入的行。理想情况下，我希望保留第一段数据（第A列，第8行），并将其余部分粘贴在下面。

我已经编写了一些代码，但似乎无法完成它。

    Sub Macro3()
Dim example As Range
Set example = Range("A1")

example.Rows(8).Select

usedRangeLastColNum = ActiveSheet.UsedRange.Columns.Count
MsgBox usedRangeLastColNum

example.EntireRow(9).Insert


    End Sub

我不需要弹出消息框。我只是用它来确保我的代码得到正确的数字。

我认为，基于我对此完全陌生的事实，我已经相当远了。

非常感谢！

电子

Answer 1

也许这很精通？应该做你想做的事

<强> EDITED

Sub LoopSheets()

Dim WS As Worksheet
Dim CL As Long, X As Long

For Each WS In ThisWorkbook.Sheets
    CL = WS.Cells(8, Columns.Count).End(xlToLeft).Column
    If CL > 1 Then
        WS.Cells(9, 1).EntireRow.Resize(CL - 1).Insert Shift:=xlDown
        For X = 2 To CL
            WS.Cells(7 + X, 1) = WS.Cells(8, X)
            WS.Cells(8, X).ClearContents
        Next X
    End If
Next WS

End Sub

Answer 2

这将在第8行中转换您的值（从单元格A9开始）并将所有数据向下移动。（向下移动将等于第8行中范围的长度）

您还应该在运行循环时禁用屏幕更新

Sub Transpose()

Dim WS As Worksheet
Dim LCol As Long
Dim CopyRange As Range

Application.ScreenUpdating = False

For Each WS In Worksheets
    LCol = WS.Cells(8, WS.Columns.Count).End(xlToLeft).Column 'Determine Last Column
    WS.Range("A9").EntireRow.Resize(LCol).Insert Shift:=xlDown 'Insert new cells to accommodate space for transpose
    Set CopyRange = Range(Cells(8, 1), Cells(8, LCol)) 'dynamic copy range
    CopyRange.Copy
    WS.Range("A9").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, , True
‘Add line to delete row 8 here
Next WS

Application.ScreenUpdating = False

End Sub

Answer 3

从A2到A8的范围是我们将要转置到D2到J2范围的数组。

CREATE PROCEDURE

以下是代码：

       A    B    C    D    E    F    G    H    I    J
1
2      1              1    2    3    4    5    6    7
3      2
4      3
5      4
6      5
7      6
8      7

计算单元格然后将数据转置到

3 个答案: