0
votes

I'm new to VBA and I'm working on a project. I've searched around the internet and managed to put something together using others' examples. The basic idea is that the code copies user-selected data to a single master workbook. This is what I have so far;

Sub SelectOpenCopy()
Dim vaFiles As Variant
Dim i As Long
Dim DataBook As Workbook
Dim DataSheet As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

vaFiles = Application.GetOpenFilename(Title:="Select files", MultiSelect:=True)

If IsArray(vaFiles) Then
    For i = LBound(vaFiles) To UBound(vaFiles)
        Set DataBook = Workbooks.Open(FileName:=vaFiles(i))
        
        For Each DataSheet In ActiveWorkbook.Sheets
        DataSheet.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
        Next DataSheet
        
        DataBook.Close savechanges:=False
    Next i
End If

End Sub

Two problems with this is that:

  1. If I run the code again and select the same files, new worksheets are made in the master workbook and that isn't what I'm going for. If those worksheets already exist, I want them to be updated instead of new ones being made. If it helps to mention, all the workbooks that need to be copied to the master file only have one worksheet each and the worksheet name matches its workbook too.

  2. The code copies all the data, but I only need a set range ("A1:L1000").

There's a lot I don't understand about VBA, so any and all help is really appreciated!

2

2 Answers

0
votes
...
Const CopyAddress = "A1:L1000"
Dim MasterSheet As Worksheet, SheetName As String, SheetExists As Boolean
...
For Each DataSheet In DataBook.Worksheets
  SheetName = DataSheet.Name
  SheetExists = False
  For Each MasterSheet In ThisWorkbook.Worksheets
    If MasterSheet.Name = SheetName Then
      SheetExists = True
      Exit For
    End If
  Next MasterSheet
  If SheetExists Then
    DataSheet.Range(CopyAddress).Copy MasterSheet.Range(CopyAddress).Cells(1, 1)
  Else
    DataSheet.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
  End If
Next DataSheet
...
0
votes

enter image description here

When you run it, don't forget to change the path for the target workbook.

Sub moveData()

'turn off unnecessary applications to make the macro run faster
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Dim target_wb As Workbook
Dim main_wb As Workbook
Dim file_sheet As Worksheet
Dim exists As Boolean
Dim next_empty_row As Long
Dim R As Range
Dim sheet_name As String

Set main_wb = ThisWorkbook

Set R = _
Application.InputBox("please select the data range:", "Kutools for Excel", , , , , , 8)

sheet_name = ActiveSheet.Name

R.Select
Selection.copy

'workbook path to paste in
Set target_wb = _
Workbooks.Open("/Users/user/Desktop/target.xlsx")

For Each file_sheet In target_wb.Sheets

        Application.DisplayAlerts = False
        
        If file_sheet.Name = main_wb.ActiveSheet.Name Then
             exists = True
             Exit For
        Else
            exists = False
        End If

Next file_sheet

If exists = False Then
    target_wb.Sheets.Add.Name = sheet_name
End If

next_empty_row = _
target_wb.Sheets(sheet_name).Cells(Rows.Count, 1).End(xlUp).Row + 1

target_wb.Sheets(sheet_name).Cells(next_empty_row, 1).PasteSpecial

target_wb.Save
target_wb.Close

'turn on applications
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

End Sub