EXCEL 如何用VBA语言将一个EXCEL文件中不同sheet中的同一列数据按顺序导入到一个sheet中去？ VBA如何将多个不同的Excel文件批量导入到一个新的Exc...

EXCEL \u5982\u4f55\u7528VBA\u8bed\u8a00\u5c06\u4e00\u4e2aEXCEL\u6587\u4ef6\u4e2d\u4e0d\u540csheet\u4e2d\u7684\u5217\u6570\u636e \u6309\u5217\u987a\u5e8f \u5bfc\u5165\u5230\u4e00\u4e2asheet\u4e2d\u53bb?

Public Sub HBsh() Dim Sh As Worksheet, i As Long i = 1 For Each Sh In Worksheets If Sh.Name "\u603b\u7684" Then Sheets("\u603b\u7684").Cells(1, i).Resize(Sh.Range("A1").CurrentRegion.Rows.Count, Sh.Range("A1").CurrentRegion.Columns.Count).Value = Sh.Range("A1").CurrentRegion.Value i = i + Sh.Range("A1").CurrentRegion.Columns.Count End If NextEnd Sub

\u6211\u6bcf\u6708\u5904\u7406\u4e00\u4e07\u4e2aexcel\u6587\u4ef6\uff0c\u6bcf\u4e2a\u6587\u4ef6\u91cc\u62bd\u53d6\u7b26\u5408\u6761\u4ef6\u7684\u90e8\u5206\u518d\u5408\u5e76\u5230\u4e00\u8d77\u3002
\u770b\u4f60\u6709\u591a\u5c11\u6587\u4ef6\uff0cvba\u6548\u7387\u662f\u4e00\u79d2\u4e00\u4e2a\u6587\u4ef6\uff0cVBA+sql\u5feb10\u500d\uff0cpython\u518d\u5feb10\u500d\u3002\u6211\u7528python\u4e00\u822c15\u5206\u949f\u5185\u5904\u7406\u5b8c\u4e00\u4e07\u4e2a\u6587\u4ef6\u3002
vba\u4e5f\u5f88\u7b80\u5355\uff0c\u4f60\u5f55\u5236\u5b8f\uff0c\u5f55\u5236\u5bfc\u5165\u4e00\u4e2a\u6587\u4ef6\u7684\uff0c\u4ee3\u7801\u8d34\u4e0a\u6765\uff0c\u6211\u4eec\u6539\u4e0b\u5c31ok\u3002
\u53ef\u4ee5\u53d1\u6837\u8868\uff0c50\u5757\u505a\u597d\u7ed9\u4f60\u3002\u79c1\u4fe1\u3002

代码如下, 详见附件的示例文件。

Sub MergeData()
    '将其他sheet的同列数据合并到第一张sheet
    Dim i As Integer, N As Integer
    Dim j As Long, k As Long

    N = Sheets.Count
    '如果工作簿中只有一张工作表，则退出
    If N = 1 Then Exit Sub

    '确定工作表的列数(假定其他工作表都与第一张工作表数据结构相同)
    '采用第一张工作表中第一列最后一行不为空的单元格的相邻区域的列数来确定
    '不采用A1相邻区域的列数来确定是防 止习惯将第1行留空或者第一行设为总标题，其下留空行的大众化习惯
    With Sheets(1)
        k = .Cells(.Rows.Count, 1).End(xlUp).CurrentRegion.Columns.Count
    End With

    '确定其他工作第一行是否为标题行
    '如果有标题行，则复制时应不包含标题行
    Dim Response, r As Integer
    Response = MsgBox("要合并数据的工作表中第一行为标题行吗？", vbYesNo)
    If Response = vbYes Then
        r = 2
    Else
        r = 1
    End If

    Application.ScreenUpdating = False

    For i = 2 To N
        With Sheets(i)
            j = .Cells(.Rows.Count, 1).End(xlUp).Row
            .Range(.Cells(r, 1), .Cells(j, k)).Copy Sheets(1).Cells(Sheets(1).Rows.Count, 1).End(xlUp).Offset(1, 0)
        End With
    Next i

    Application.ScreenUpdating = True
    Application.CutCopyMode = False
End Sub

右键总表，查看代码。粘贴如下代码。

sub mysub
dim i as integer
for i= 2 to sheets.count
sheets(i).range("e22:e" & sheets(i).[e65536].end(3).row).copy range("iv3").end(xltoleft).offset(,1)
next i
end sub

扩展阅读：vba入门实例 ... 录入vba必背代码大全 ... vba编程必背50个程序 ... vba for wps2019 ... python vba ... vba快捷打开 ... 未安装vba如何启用宏 ... excel vba实例详解 ... excel vba编程教程完整版 ...