Question

如何用宏把excel中每个工作表的第二列提取到新工作表中

你好，我的excel工作薄中总共有128个工作表，第i个工作表名为“cycle i”。每个表都有三列，分别是电压、电流和电阻。我想把所有工作表里的第二列，也就是电流一列都提取出来放到一张新工作表里。请问应该如何编写宏？

Answer 1

1，程序为：
Sub 提取第二行()
Dim wks As Worksheet, sht As Worksheet
On Error Resume Next
Set wks = Worksheets("汇总表")
If Err <> 0 Then Worksheets.Add(before:=Sheets(1)).Name = "汇总表"
For Each sht In Sheets
If sht.Name <> "汇总表" Then
sht.Range("A2").EntireRow.Copy Sheets("汇总表").Range("A" & Sheets("汇总表").Cells(Rows.Count, 1).End(xlUp).Row + 1)
End If
Next
End Sub
2，如果没有汇总表则新建汇总表。将非汇总表的其他表里面的第二行分别复制并粘贴进汇总表，粘贴位置为A列的第一个空白行。

Answer 2

假如有两个工作表book1.xls,和book2.xls
book1里是原数据，现在book2要从book1中提取数据：
将如下代码复制->粘贴到book2的sheet1代码编辑窗口下：
'注意在Book2的sheet1的A1中要填写文件路径，比如：D:\
Sub 提取()
Dim i As Integer, j As Integer
Dim str As String
str = Sheet1.Cells(1, 1) '在本工作薄的A1单元格中需要填写文件路径
Application.ScreenUpdating = False
On Error Resume Next '如果book1.xls已经打开,若无此句则会出现提示:A.xls已经打开,需要重新打开吗。
Workbooks.Open Filename:=str & "book1.xls" '如果book1.xls未打开则将其打开
For i = 1 To Workbooks("book1.xls").Worksheets.Count Step 1
Cells(2, i) = "cycle" & i & "电流"
For j = 2 To 10000 Step 1 '假设数据有10000行
If Workbooks("book1.xls").Worksheets("cycle " & i).Cells(j, 2) = "" Then Exit For
If Cells(j + 1, i) <> Workbooks("book1.xls").Worksheets("cycle " & i).Cells(j, 2) Then
Cells(j + 1, i) = Workbooks("book1.xls").Worksheets("cycle " & i).Cells(j, 2)
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub

Answer 3

假如提取的数据要放在“电流汇总表”里，可以使用下面的宏：

Sub 提取()
With Sheets("电流汇总表")
.Cells.Clear
For i = 1 To 128
Sheets("cycle " & i).Columns(2).Copy .Cells(1, i)
Next
End With
End Sub

Answer 4

Sub 创建汇总表()
Application.ScreenUpdating = False
On Error Resume Next
Set sht = Sheets("汇总")
If Err = 0 Then Exit Sub
Sheets.Add(after:=Sheets(Sheets.Count)).Name = "汇总"
For i = 1 To 128
With Sheets("汇总")
Set j = Sheets("cycle " & i).Range("B2:B" & Sheets("cycle " & i).Range("B65536").End(xlUp).Row())
.Cells(1, i).Resize(Sheets("cycle " & i).Range("B65536").End(xlUp).Row() - 1, 1) = j.Value
End With
Next
Application.ScreenUpdating = True
End Sub

Answer 5

Sub 电流表()
For i = 1 To 128
Sheets("cycle " & Trim(Str(i))).Select
Columns("B:B").Select
Selection.Copy
Sheets("电流").Select
If i <= 26 Then
bt = Chr(i + 64) + ":" + Chr(i + 64)
Else
hh1 = Int(i / 26)
hh2 = i Mod 26
If hh2 = 0 Then
hh1 = hh1 - 1
hh2 = 26
End If
bt = Chr(64 + hh1) + Chr(64 + hh2) + ":" + Chr(64 + hh1) + Chr(64 + hh2)
End If
Columns(bt).Select
ActiveSheet.Paste
Next i
End Sub