CODEWITHSUNDEEP
excelvbamulti-selectgetopenfilename
spliff_kingsbury
spliff_kingsbury

Reputation: 1

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

I have the below code that works perfectly for opening a file, selecting 1 file and it automatically copies from A2:AA2 and pastes under my master sheet of data (below my current data). I am looking to add a feature where I can select multiple sheets, where it will copy from A2:AA2 in all of the selected excel sheets (max 30) and either combine into 1 sheet (where i can then paste later on); Or all be pasted below each other in my master sheet.

Thanks


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

Upvotes: -1

Views: 60

Answers (1)

Guillaume BEDOYA
Guillaume BEDOYA

Reputation: 265

Here is a piece of code allowing you to choose which worksheets copying data from in a Workbook:

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

Upvotes: 0

Related Questions