簡體   English   中英

單擊按鈕后使用宏將數據保存到另一個Excel工作簿

[英]Save data to another excel workbook after button click using macro

我有2個工作簿:main.xlsm(主要工作簿)和backup.xlsx(備份)。 現在,我想要的是在使用宏單擊按鈕時將備份副本保存到backup.xlsx。 我有下面的代碼,但我不知道為什么它不起作用。

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

在循環中,您將數據分配給ws2工作簿,然后保存/關閉wkb。 我認為將wkb添加到循環中可以完成這項工作。

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM