1

我有 xls 文件，其中包含多张工作表和多列数据（以 6 列为一组）。我必须将这些数据复制到最后一张，每张都在最后一张下。

换句话说，它现在看起来像这样：

A B C D

A B C D

A B C D

我希望它在最后一张表中看起来像这样：

一个

一个

一个

b

b

b

C

C

C

d

d

d

我设法创建了从每张表中复制前 6 列的宏，但我无法创建一个循环来遍历每张表中的列：

Sub kopiuj_wszystko()

Dim kolumna As Integer
For Each oWBK In ThisWorkbook.Worksheets
For j = 1 To 1000
If oWBK.Name <> "podsumowanie" Then
' Kopiuj

oWBK.Select

x = Range(j & "1000").End(xlUp).Row 'sprawdź ilość wypełnionych wierszy
y = 6 'ogranicz do kolumny F
oWBK.Cells(x, y).Select
Z = ActiveCell.Address
Range("A9", Z).Select
'Application.CutCopyMode = False
Selection.Copy

'Wklej
Sheets("podsumowanie").Select
E = Range("c10000").End(xlUp).Row
R = 3
Sheets("podsumowanie").Cells(E, R).Select

ActiveSheet.Paste

'Kopiuj kategorię
oWBK.Select
T = Range("A1").Value
Application.CutCopyMode = False
Selection.Copy

'Wklej kategorię
w = 1
Sheets("podsumowanie").Select
Sheets("podsumowanie").Cells(E, w).Select
L = ActiveCell.Address
Range(L).Value = T

'Kopiuj index
oWBK.Select
T = Range("C3").Value
Application.CutCopyMode = False
Selection.Copy

'Wklej index
w = 2
Sheets("podsumowanie").Select
Sheets("podsumowanie").Cells(E, w).Select
L = ActiveCell.Address
Range(L).Value = T

End If
Next j

Next oWBK

End Sub
4

1 回答 1

1

这里的代码非常简单，无论有多少列都可以工作：（循环通过每个单元格（数据量大时速度慢）

Sub ColumnsToOne()

Dim wsT As Worksheet: Set wsT = ThisWorkbook.Sheets("Sheet2")
Dim x As Long
Dim y As Long
Dim z As Long

z = 1
For Each wsF In ThisWorkbook.Sheets
x = 1
y = 1
If wsF.Name <> wsT.Name Then
    Do While Len(wsF.Cells(x, y)) <> 0
        Do While Len(wsF.Cells(x, y)) <> 0
            wsF.Cells(x, y).Copy wsT.Cells(z, 1): z = z + 1: x = x + 1
        Loop
        x = 1: y = y + 1
    Loop
End If
Next

End Sub

下面的代码复制每个范围并将其添加到工作表中：（使用大数据集更快）

Sub CopyColumnsToOne()
Dim wsT As Worksheet: Set wsT = ThisWorkbook.Sheets("Sheet2")
Dim y As Long
For Each wsF In ThisWorkbook.Sheets
    If wsF.Name <> wsT.Name Then
        For y = 1 To 6
            wsF.Range(wsF.Cells(1, y), wsF.Cells(wsF.Cells(wsF.Rows.Count, y).End(xlUp).Row, y)).Copy wsT.Cells(wsT.Range("A65536").End(xlUp).Row + 1, 1)
        Next
    End If
Next
End Sub
于 2012-08-29T10:36:10.423 回答