Home > Enterprise >  VBA Copy Sheets From external Workbook and overwrite them on existing sheets with new values (includ
VBA Copy Sheets From external Workbook and overwrite them on existing sheets with new values (includ

Time:02-16

I had similar question, that I posted over 1y ago, and it was basically solved but... Here is the link for more infos:

VBA CopySheetsFromClosedWorkbook but overwrite (update) existing sheets with new values

Recently I bumped on some issue where I am facing WBs with different Sheet names but with the same content. Every time I am having this issue I need to tweak a code a bit, to adjust it for right Sheet names. is there any function or additional array that I can include in the code so that it recognises if the Sheet1 had name XYZ and now ZYX to still proceed with code and get me the data?

In my case, also you can see in the code, it is only matter of two different names with numbering. Original Sheet name is "CH_or_Recipe_1 to 8", but sometimes I will have cases with "Chamber 1 to 8". I would like to have defined those Sheet names within my code so that I dont need to adjust it manually every time I wanna copy the data.

And last additional question or favor is, to export the exact WB but without .xlsm (without macro) in .xlsx with all the data. So Macro WB would be like an intermediar to gather the data and export them...

This is coding part:

Sub CopySheetFromClosedWorkbook2()
    
    'Prompt to choose your file in the chosen locatioon
    Dim dialogBox As FileDialog
    Dim FilePath As String
    Set dialogBox = Application.FileDialog(msoFileDialogOpen)
    Application.StatusBar = "Choose older PDS Form!"

    dialogBox.AllowMultiSelect = False
    dialogBox.Title = "Select a file"
    If dialogBox.Show = -1 Then
        FilePath = dialogBox.SelectedItems(1)
        
    'If nothing selected then MsgBox
    Else
       MsgBox "No PDS Form selected!"
       Exit Sub
    End If
    
    'Here are sheets defined which you are going to copy/paste (reference update) but to keep formatting.
    ''Sheets should be defined from right to left to have your sheets sorted from the beginning
    Dim shNames As Variant: shNames = Array("CH_or_Recipe_8", "CH_or_Recipe_7", "CH_or_Recipe_6", "CH_or_Recipe_5", "CH_or_Recipe_4", _
    "CH_or_Recipe_3", "CH_or_Recipe_2", "CH_or_Recipe_1", "Customer Details", "Instructions")
    
    
    '"Chamber 8", "Chamber 7", "Chamber 6", "Chamber 5", "Chamber 4", "Chamber 3", _
    "Chamber 2", "Chamber 1"
    
    
    Dim tgt As Workbook: Set tgt = ThisWorkbook
    Application.ScreenUpdating = False
    Dim src As Workbook: Set src = Workbooks.Open(FilePath)
    Dim ws As Worksheet, rng As Range, i As Long
    For i = 0 To UBound(shNames)
        On Error Resume Next
        Set ws = src.Sheets(shNames(i))
        If Err.Number = 0 Then
            tgt.Worksheets(shNames(i)).Cells.Clear
            Set rng = ws.UsedRange
            rng.Copy tgt.Worksheets(shNames(i)).Range(rng.Address)
        End If
    Next i
    src.Close False
    Application.ScreenUpdating = True
    MsgBox "Copy&Paste successful!"
End Sub

CodePudding user response:

Change the sheets names for those ending in a number 1 to 8

    Dim src As Workbook: Set src = Workbooks.Open(FilePath)
    Dim ws As Worksheet, rng As Range, i As Long
    ' add code here
    For Each ws In src.Sheets
        If ws.Name Like "*[1-8]" Then
            ws.Name = "CH_or_Recipe_" & Right(ws.Name, 1)
        End If
    Next
    ' existing
    For i = 0 To UBound(shNames)

Save as XLSX


Sub SaveNoMacro()

    Dim fn As String
    With ThisWorkbook
        fn = Replace(.FullName, ".xlsm", ".xlsx")
         Application.DisplayAlerts = False
        .SaveAs fn, FileFormat:=xlWorkbookDefault
         Application.DisplayAlerts = True
    End With
    MsgBox "Saved as " & fn
    
End Sub
  • Related