宏，用于复制和转置新工作表中的每隔第七行和过去的内容 [英] macro to copy and transpose every seventh row and past in new sheet

问题描述

我正在为代理进行调查，系统会以XML格式向我提供报告.当我将相同的更改更改为Excel时，将以以下提到的格式获取调查

I have surveys being done for my agents the system gives me a report in XML format. When I get the same changed to Excel I get the surveys in the below mentioned format

Survey number
Agent Name
Rating 1
Rating 2
Rating 3 
Rating 4 
Rating 5
Comments

使用这种格式，我每天大约需要进行700次调查，因此我需要将其转换为以下提到的格式

With this format I have around 700 surveys every day and I need to get the same transposed to the below mentioned format

Survey number/Agent Name/Rating 1/Rating 2/Rating 3/Rating 4/Rating 5/Comments

问题是宏不断打开，文件变得沉重.

The problem is the macro goes on and on and the file becomes heavy.

任何人都可以帮助宏如何检测下一个调查并自动复制一张纸上的数据，然后将其转置到下一张纸上，以使其位于前一行的正下方.我对VB的了解不多.

Can anyone help as to how a macro could detect the next survey and automatically copy the data from one sheet and then transpose the same on the next sheet so as to fall right below the earlier line. I do not have much of knowledge in VB.

推荐答案

这是只有一个循环的另一种方式

Here's another way with just a single loop

Public Sub TransposeData()
Dim LastRow As Long
Dim NextRow As Long
Dim i As Long

    Application.ScreenUpdating = False
    With Worksheets("Sheet1")

        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 1 To LastRow Step 8

            .Cells(i, "A").Resize(8).Copy
            NextRow = NextRow + 1
            .Cells(NextRow, "B").PasteSpecial Paste:=xlPasteAll, transpose:=True
        Next i

        .Rows(NextRow + 1).Resize(LastRow - NextRow).Delete
        .Columns(1).Delete
    End With

    Application.ScreenUpdating = True
End Sub

这篇关于宏，用于复制和转置新工作表中的每隔第七行和过去的内容的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！