mardi 30 juin 2020

How to do code loop until last sheet in another workbook using VBA code Excel?

good people, I hope you have a nice day. I am new to Excel Macro VBA here. I need to build Excel Macro Enabled Workbook for specific data processing.

Background: I am trying to copy data as values from every sheet from "source" workbook to a table in my master workbook, then when every data on every sheet has been copied, I need to remove duplicates from that table in my master workbook.

Problem: The number of sheets in "source" workbook is uncertain.

Goal: To copy from every sheet in "source" workbook, stacked in my master workbook then remove duplicates in my master workbook.

I provided my set of code for single sheet "source" workbook, please help me achieve my goal. I tried using do while loop, do until loop but they failed to execute my code

Sub Copy_SourceToMaster()

    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Activate
        Range("C6").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        ThisWorkbook.Activate
        ActiveSheet.Range("B4").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        OpenBook.Close False
    
    End If
    Application.ScreenUpdating = True
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

Set sht = ActiveSheet
Set StartCell = Range("B5")

'Find Last Row and Column
  LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
  LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column

'Select Range
  sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
  Selection.RemoveDuplicates Columns:=2, Header:= _
        xlYes
    Range("B5").Select
    Selection.End(xlDown).Select
End Sub

Aucun commentaire:

Enregistrer un commentaire