繁体   English   中英

VBA - 从 A2:AA2 复制多页 excel 粘贴在一张纸上,或粘贴在当前纸下

[英]VBA - Copying from A2:AA2 in multiple excel sheets to be pasted in one sheet, or to be pasted below current sheet

我有下面的代码,可以完美地打开一个文件,选择 1 个文件,它会自动从 A2:AA2 复制并粘贴到我的主数据表下(在我的当前数据下方)。 我想添加一个功能,我可以 select 多张纸,它将从 A2:AA2 复制到所有选定的 excel 张(最多 30 张)中,然后合并成一张纸(我可以稍后粘贴); 或者全部粘贴在我的主表中。

谢谢


Sub add_data()

    Dim openfile As String
    Dim OpenBook As Workbook
    Dim targetworkbook As String, targetsheetname As String


    Application.ScreenUpdating = False
    
    targetworkbook = Application.GetOpenFilename(FileFilter:="Excel Files, *.xls*", _
    Title:="Select Data", MultiSelect:=True)
    
 
    If targetworkbook = "False" Or openfile = "" Then
    
        'If the value is false or null then exit
        
        Set OpenBook = Application.Workbooks.Open(targetworkbook)
        OpenBook.Sheets(1).Select
            Range("A2:AA2").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
       ThisWorkbook.Worksheets("xxx").Range("A4").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        OpenBook.Close False

    
    End If
    Application.ScreenUpdating = True
End Sub

这是一段代码,允许您选择从工作簿中复制数据的工作表:

Sub add_data()

    Dim OpenBook As Workbook
    Dim targetworkbook As String
    Dim wsh As Worksheet
    Dim coll As New Collection
    Dim selected_sheets As Variant
    Dim sheets_() As String
    Dim j As Integer
    Dim elt
    
    Application.ScreenUpdating = False
    
    targetworkbook = Application.GetOpenFilename(FileFilter:="Excel Files, *.xls*", _
    Title:="Select Workbook to open", MultiSelect:=False)
    
 
    If targetworkbook <> "False" And targetworkbook <> "Faux" Then
        
        Set OpenBook = Workbooks.Open(targetworkbook, , True)
        
        For Each wsh In OpenBook.Worksheets
            coll.Add wsh.Name
        Next wsh
        
        j = 1
        ReDim sheets_(1 To coll.count)
        For Each elt In coll
            sheets_(j) = elt
            j = j + 1
        Next elt
    
        selected_sheets = Split(InputBox("Here are the sheets availables: " & vbNewLine & Join(sheets_, ", ") & vbNewLine & "Please enter the sheets you want to select, separated by a comma", "Please select sheets to copy from", ""), ",")
        
        For Each wsh In OpenBook.Worksheets
            For Each elt In selected_sheets
                If wsh.Name = Trim(CStr(elt)) Then
                    With wsh
                        .Activate
                        .Range("A2:AA2").Select
                        .Range(Selection, Selection.End(xlDown)).Copy
                    End With
                    ThisWorkbook.Worksheets("xxx").Range("A4").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                    Application.CutCopyMode = False
                End If
            Next elt
        Next wsh
        
        OpenBook.Close False
        
    End If
    Application.ScreenUpdating = True
End Sub

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM