简体   繁体   中英

Save data to another excel workbook after button click using macro

I have 2 workbooks: the main.xlsm (main workbook) and backup.xlsx (backup). Now what I want is to save a backup copy to backup.xlsx upon clicking a button using macro. I have the code below, but I don't know why it wouldn't work.

Sub ToggleEvents(blnState As Boolean)
    With Application
        .DisplayAlerts = blnState
        .EnableEvents = blnState
        .ScreenUpdating = blnState
        If blnState Then .CutCopyMode = False
        If blnState Then .StatusBar = False
    End With
End Sub

Function WbOpen(wbName As String) As Boolean
    On Error Resume Next
    WbOpen = Len(Workbooks(wbName).Name)
End Function

Sub Transfer()
Dim c As Integer
Dim Ws1 As Worksheet, Ws2 As Worksheet

Dim wkb As Workbook
Dim FilePath As String, FileName As String
Dim blnOpened As Boolean

'the next two refer to the destination file path and filename
FilePath = "C:\Newfolder\"
FileName = "backup.xlsx"

Call ToggleEvents(False)
    If WbOpen(FileName) = True Then
    Set Ws2 = Workbooks("backup.xlsx").Sheets("RAW")
    blnOpened = False
    Else
        If Right(FilePath, 1) <> Application.PathSeparator Then
            FilePath = FilePath & Application.PathSeparator
        End If
        Set wkb = Workbooks.Open(FilePath & FileName, , , , "backup.xlsx")
        Set Ws2 = Workbooks("backup.xlsx").Sheets("RAW")


        blnOpened = True
    End If

    Set Ws1 = ThisWorkbook.Sheets("ProdTracker")

c = 2
Do While Ws2.Range("A" & c) <> ""
    c = c + 1
    Loop
    Ws2.Range("A" & c) = Ws1.Range("AA2")
    Ws2.Range("B" & c) = Ws1.Range("AA3")
    Ws2.Range("C" & c) = Ws1.Range("AA42")
    Ws2.Range("D" & c) = Ws1.Range("AA4")
    Ws2.Range("E" & c) = Ws1.Range("AA5")
    Ws2.Range("F" & c) = Ws1.Range("AA6")
    Ws2.Range("G" & c) = Ws1.Range("AA7")
    Ws2.Range("H" & c) = Ws1.Range("AA8")
    Ws2.Range("I" & c) = Ws1.Range("AA9")
    Ws2.Range("J" & c) = Ws1.Range("AA10")
    Ws2.Range("K" & c) = Ws1.Range("AA11")
    Ws2.Range("L" & c) = Ws1.Range("AA12")
    Ws2.Range("M" & c) = Ws1.Range("AA13")
    Ws2.Range("N" & c) = Ws1.Range("AA14")
    Ws2.Range("O" & c) = Ws1.Range("AA15")
    Ws2.Range("P" & c) = Ws1.Range("AA16")
    Ws2.Range("Q" & c) = Ws1.Range("AA17")
    Ws2.Range("R" & c) = Ws1.Range("AA18")
    Ws2.Range("S" & c) = Ws1.Range("AA19")
    Ws2.Range("T" & c) = Ws1.Range("AA20")
    Ws2.Range("U" & c) = Ws1.Range("AA21")
    Ws2.Range("V" & c) = Ws1.Range("AA22")
    Ws2.Range("W" & c) = Ws1.Range("AA23")
    Ws2.Range("X" & c) = Ws1.Range("AA24")
    Ws2.Range("Y" & c) = Ws1.Range("AA25")
    Ws2.Range("Z" & c) = Ws1.Range("AA26")
    Ws2.Range("AA" & c) = Ws1.Range("AA27")
    Ws2.Range("AB" & c) = Ws1.Range("AA28")
    Ws2.Range("AC" & c) = Ws1.Range("AA29")
    Ws2.Range("AD" & c) = Ws1.Range("AA30")
    Ws2.Range("AE" & c) = Ws1.Range("AA31")
    Ws2.Range("AF" & c) = Ws1.Range("AA32")
    Ws2.Range("AG" & c) = Ws1.Range("AA33")
    Ws2.Range("AH" & c) = Ws1.Range("AA34")
    Ws2.Range("AI" & c) = Ws1.Range("AA35")
    Ws2.Range("AJ" & c) = Ws1.Range("AA36")
    Ws2.Range("AK" & c) = Ws1.Range("AA37")
    Ws2.Range("AL" & c) = Ws1.Range("AA38")
    Ws2.Range("AM" & c) = Ws1.Range("AA39")
    Ws2.Range("AN" & c) = Ws1.Range("AA40")
    Ws2.Range("AO" & c) = Ws1.Range("AA41")
    Ws2.Range("AP" & c) = Ws1.Range("AA43")
    Ws2.Range("AQ" & c) = Ws1.Range("AA44")
    Ws2.Range("AR" & c) = Ws1.Range("AA45")
    Ws2.Range("AS" & c) = Ws1.Range("AA46")
    Ws2.Range("AT" & c) = Ws1.Range("AA47")
    Ws2.Range("AU" & c) = Ws1.Range("AA48")
    Ws2.Range("AV" & c) = Ws1.Range("AA49")
    Ws2.Range("AW" & c) = Ws1.Range("AA50")
    Ws2.Range("AX" & c) = Ws1.Range("AA51")
    Ws2.Range("AY" & c) = Ws1.Range("AA52")


        If blnOpened = True Then
        wkb.Close SaveChanges:=True
        End If
End Sub

In the loop you are assigning data to ws2 workbook and after that you save/close wkb. I think adding wkb to the loop would fo the job.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

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