VBA一个用于多个子程序的输入框

时间:2018-02-19 07:21:22

标签: vba excel-vba excel

您好我有这个代码我的问题是关于inputbox。我的输入框用于登录我保存报告的最后一个文件夹。但是我希望这个输入框的值(也就是2018年1月)也可以在子spracovanie2中使用安全的代码来编写代码。如何使一个输入框适用于两个子预测。我不想两次相同的价值。我可以以某种方式公开吗? 如果您认为我没有明确表达自己,请发表评论。

    Sub Spracovanie1()
Dim wb As Workbook
Dim wb2 As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim mesiac_rok As String

mesiac_rok = InputBox("Mesiac/Rok")

Set wb = Workbooks.Open("????????\" & mesiac_rok & "\??????.xlsx")
Set ws = wb.Sheets("Check List Action plan Opr")
Set rng = ws.Cells(ws.Rows.Count, 2).End(xlUp).Offset(1, 0)

Set wb2 = Workbooks.Open("????????\" & mesiac_rok & "\??????.xlsx")
Set ws2 = wb2.Sheets("Check List Action plan Opr")
Set rng2 = ws2.Range("B4").CurrentRegion.Offset(1, 0)
    rng2.Resize(rng2.Rows.Count - 1).Copy Destination:=rng
    wb2.Close

Set wb2 = Workbooks.Open("????????\" & mesiac_rok & "\??????.xlsx")
Set ws2 = wb2.Sheets("Check List Action plan Opr")
Set rng = ws.Cells(ws.Rows.Count, 2).End(xlUp).Offset(1, 0)
Set rng2 = ws2.Range("B4").CurrentRegion.Offset(1, 0)
    rng2.Resize(rng2.Rows.Count - 1).Copy Destination:=rng
    wb2.Close


Set wb2 = Workbooks.Open("????????\" & mesiac_rok & "\??????.xlsx")
Set ws2 = wb2.Sheets("Check List Action plan Opr")
Set rng = ws.Cells(ws.Rows.Count, 2).End(xlUp).Offset(1, 0)
Set rng2 = ws2.Range("B4").CurrentRegion.Offset(1, 0)
    rng2.Resize(rng2.Rows.Count - 1).Copy Destination:=rng
    wb2.Close


Set wb2 = Workbooks.Open("????????\" & mesiac_rok & "\??????.xlsx")
Set ws2 = wb2.Sheets("Check List Action plan Opr")
Set rng = ws.Cells(ws.Rows.Count, 2).End(xlUp).Offset(1, 0)
Set rng2 = ws2.Range("B4").CurrentRegion.Offset(1, 0)
    rng2.Resize(rng2.Rows.Count - 1).Copy Destination:=rng
    wb2.Close

Set wb2 = Workbooks("?????.xlsm")
Set ws2 = wb2.Sheets("Check List Action plan Opr")
Set rng2 = ws2.Range("B1")
    ws.UsedRange.Copy Destination:=rng2


wb.SaveAs Filename:=("????????\" & mesiac_rok & "\??????.xlsx)"
wb.Close
End Sub

Sub Spracovanie2()
'
    Dim wb As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim rng As Range
Dim LastRow As Long

    Set wb = Workbooks("Reporting AP Bwise source.xlsm")
    Set ws = wb.Sheets("Check List Action plan Opr")
    Set rng = ws.Range("B4").CurrentRegion
    Set ws2 = wb.Sheets("OPR Action plans_TEMP")

    rng.Copy Destination:=ws2.Range("A1")
    ws2.Range("A1").CurrentRegion.UnMerge


    LastRow = ws2.Cells(Rows.Count, 1).End(xlUp).Row
        ws2.Range("A1:AP" & LastRow).Sort Key1:=ws2.Range("N1:N" & LastRow), _
            Order1:=xlAscending, Header:=xlYes


    Set ws = wb.Sheets("OPEN AP")
         ws.UsedRange.ClearContents
    Set ws2 = wb.Sheets("CLOSED AP")
         ws2.UsedRange.ClearContents
end sub

0 个答案:

没有答案