如果文件未打开，请转到下一步

时间：2017-09-27 13:12:02

标签： excel vba excel-vba

从多个工作簿中，我将信息复制到一个工作簿中。这就像一个魅力。我刚刚获悉，几周后我将不得不添加另一个文件来复制数据。我想让Macro现在开始，但如果我没有打开新的工作簿，宏就会被卡住。我尝试了几种不同的方法，但我不能让它发挥作用。 我有与其他3个工作簿相同的代码，所以当这个到来时，如果Workbook没有打开，我希望宏跳过它。 有什么建议？ 

Windows("filename.xlsx").Activate
Range(Range("A2:K2"), Range("A2:K2").End(xlDown)).Copy
Workbooks("Masterfile.xlsm").Sheets("Electra").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

2 个答案:

答案 0 :(得分：0)

此代码将逐步浏览您打开的工作簿，并检查您需要的文件名列表。

可能会出现几个问题：

您的工作簿必须有一张名为builder.equal(root.get("default_house"), true) 的工作表，因为代码不会对此进行检查。

如果您有一个名为Sheet1和book1.xlsm的文件。两者都发生1book1.xlsm。

可以改进列book1.xlsm中的最后一个单元格。目前，它将从A:K转到包含第A2列数据的最后一行。

所有信息都将从小区K开始粘贴。您还需要代码来查找A2表单上的最后一行。 

Electra

修改
要粘贴到Sub Test() Dim sFileNames As String Dim wrkBk As Workbook sFileNames = "Somebook.xls, book1.xlsm, book2.xlsx" For Each wrkBk In Workbooks If InStr(UCase(sFileNames), UCase(wrkBk.Name)) > 0 Then With wrkBk.Worksheets("Sheet1") .Range(.Cells(2, 1), .Cells(.Rows.Count, 11).End(xlUp)).Copy ThisWorkbook.Worksheets("Electra").Range("A2").PasteSpecial xlPasteValues End With End If Next wrkBk End Sub 一个选项中的不同工作表，可以使用字典来保存工作簿和工作簿。目的地表配对。

此代码将文件名作为键添加，目标表作为值添加。然后检查字典中是否存在工作簿名称，如果是，则复制MasterFile中的数据并将值粘贴到相关表中。 

Sheet1

编辑2：
如果源工作簿在开始时全部关闭，则使用此代码打开相关文件，复制信息并再次关闭文件。 

Sub Test()

    Dim dict As Object
    Dim wrkBk As Workbook
    Set dict = CreateObject("Scripting.Dictionary")

    dict.CompareMode = vbTextCompare
    dict.Add "Book2.xlsx", "Sheet1"
    dict.Add "Book3.xlsx", "Sheet2"

    For Each wrkBk In Workbooks
        If dict.exists(wrkBk.Name) Then
            With wrkBk.Worksheets("Sheet1")
                .Range(.Cells(2, 1), .Cells(.Rows.Count, 11).End(xlUp)).Copy
                ThisWorkbook.Worksheets(dict(wrkBk.Name)).Range("A2").PasteSpecial xlPasteValues
            End With
        End If
    Next wrkBk

End Sub

答案 1 :(得分：0)

这可能是最好看但它实际上有效，我从未做过呼叫，所以我只是尝试。我可以在不同的书籍打开的情况下多次运行，并且不会出错或搞乱。正如两次测试所做的那样。     Sub Steg11（）     “     'Steg1 Macro

'Macrot flyttar数据从CDPPT filmedörsäljningsdata，    'frånfilmedElectrasförsäljningochfil med produktdata。    'Kopierar formler，rensarförsäljning直到Lagerhållare

Dim MainWkbk As Workbook
Dim NextWkbk As Workbook
Set MainWkbk = ActiveWorkbook
Set NextWkbk = ActiveWorkbook

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

' Letar in CDPPT, lägger in formler, sorterar bladet.
On Error GoTo 3
Windows("CDPPT.xlsx").Activate
Range(Range("A2"), Range("A2").End(xlToRight).End(xlDown)).Copy
Workbooks("Datamatchningsfil.xlsm").Sheets("CDPPT").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Sheets("CDPPT").Select
Range(Range("I2"), Range("I2").End(xlToRight)).Copy
Range("H2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Offset(1, 0).Select
ActiveSheet.Paste

Application.Goto Sheets("CDPPT").Range("A:M")
Selection.Sort Key1:=Range("E1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


'Tar bort data där telia inte ska betala skatt
Application.Goto Sheets("CDPPT").Range("E1")
ActiveSheet.Range("$A:$M").AutoFilter Field:=5, Criteria1:="=*BRIGHTSTAR*" _
    , Operator:=xlAnd
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
ActiveSheet.Range("$A:$M").AutoFilter Field:=5, Criteria1:="=*ELECTRA*" _
    , Operator:=xlAnd
ActiveWindow.SmallScroll Down:=-6
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
ActiveSheet.Range("$A:$M").AutoFilter Field:=5, Criteria1:="=*Ingram*" _
    , Operator:=xlAnd
ActiveWindow.SmallScroll Down:=-9
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
ActiveSheet.Range("$A:$M").AutoFilter Field:=3, Criteria1:="=*brev*" _
    , Operator:=xlAnd
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
ActiveSheet.Range("$A:$M").AutoFilter Field:=3, Criteria1:="=*Konfig*" _
    , Operator:=xlAnd
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll
ActiveSheet.Range("$A:$M").AutoFilter Field:=5, Criteria1:="=*(Manuellt 
inmatad)*" _
    , Operator:=xlAnd
ActiveCell.Offset(1, 0).Activate
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData
ActiveWorkbook.RefreshAll

3
Call Produktdata
End Sub

Sub Produktdata()

'Letar in produktdata
On Error GoTo 4
Windows("Produktdata.xlsx").Activate
If ActiveSheet.AutoFilterMode Then Cells.AutoFilter
Range(Range("A:J"), Range("A:J").End(xlDown)).Copy
Workbooks("Datamatchningsfil.xlsm").Sheets("Produktdata").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
4
Call Electra
End Sub

Sub Electra()
'Letar in data från Lagerhållare
On Error GoTo 5
Windows("Electra sales.xlsx").Activate
Range(Range("A2:K2"), Range("A2:K2").End(xlDown)).Copy
Workbooks("Datamatchningsfil.xlsm").Sheets("Electra").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
5
Call TalkTelecom
End Sub

Sub TalkTelecom()

'Letar in data från Lagerhållare
On Error GoTo 6
Windows("TalkTelecom.xlsx").Activate
Range(Range("A2:K2"), Range("A2:K2").End(xlDown)).Copy
Workbooks("Datamatchningsfil.xlsm").Sheets("TalkTelecom").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
6
Call Techdata
End Sub

Sub Techdata()
'Letar in data från Lagerhållare
On Error GoTo 7
Windows("TechData.xlsx").Activate
Range(Range("A2:K2"), Range("A2:K2").End(xlDown)).Copy
Workbooks("Datamatchningsfil.xlsm").Sheets("TechData").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
7
Call Continue
End Sub

Sub Continue()

' Utför text till kolumn
Application.Goto Sheets("Produktdata").Range("C:C")
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(1, 1), TrailingMinusNumbers:=True

Application.Goto Sheets("CDPPT").Range("F:F")
Columns("F:F").Select
Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(1, 1), TrailingMinusNumbers:=True

Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.RefreshAll

'Lägger in år och månad i blad arbetsbeskrivning
Application.Goto Sheets("CDPPT").Range("G2")
Range("G2").Copy
Sheets("Arbetsbeskrivning").Select
Range("C10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("D10").Activate
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-1],2)"
Range("D10").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("D10").Select
Selection.TextToColumns Destination:=Range("D10"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(1, 1), TrailingMinusNumbers:=True
Range("D9").Activate
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[1]C,Datalistor!R[-6]C[1]:R[5]C[2],2,0)"
Range("C9").Activate
ActiveCell.FormulaR1C1 = "=Left(R[1]C,4)"
Range("C4").Activate


' kopierar data och skapar Pivotdata Telia försäljning
Sheets("CDPPT").Select
Range(Range("A2"), Range("A2").End(xlToRight).End(xlDown)).Copy 
Destination:=Sheets("Matchning"). _
    Range("A2")
Application.CutCopyMode = False
Sheets("CDPPT").Select
Range(Range("A2"), Range("A2").End(xlToRight).End(xlDown)).Copy 
Destination:=Sheets("Pivotgrund"). _
    Range("A2")
Application.CutCopyMode = False

ActiveWorkbook.RefreshAll

' Tar bort dubletter
Application.Goto Sheets("Matchning").Range("A:M")
Selection.Sort Key1:=Range("F1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.Goto Sheets("Matchning").Range("A1")
Range(Range("A1"), Range("A1").End(xlToRight).End(xlDown)).Select
ActiveSheet.Range("A:L").RemoveDuplicates Columns:=6, Header:= _
    xlYes

ActiveWorkbook.RefreshAll

' letar in Pivotdata
Application.Goto Sheets("Matchning").Range("H2")
ActiveCell.FormulaR1C1 = "=VLOOKUP(C[-2],Pivot!C[-7]:C[-6],2,0)"
Range("H2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste

ActiveWorkbook.RefreshAll

' Skapar fil med prod med saknad data
Application.Goto Sheets("Matchning").Range("A1")
Range("A1").Select
ActiveSheet.Range("$A:P").AutoFilter Field:=12, Criteria1:= _
    "Check for data"
Range(Range("A1"), Range("A1").End(xlToRight).End(xlDown)).Copy
Range("A1").Select
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.Windows(1).Caption = "Produktdata saknas"
Columns("M:P").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select

Windows("Datamatchningsfil.xlsm").Activate
Application.Goto Sheets("Matchning").Range("A1")
ActiveSheet.ShowAllData


ActiveWorkbook.RefreshAll
Application.ScreenUpdating = True

Sheets("Arbetsbeskrivning").Select
Range("C13").Select
With Selection.Font
    .Color = -16776961
    .TintAndShade = 0
End With
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = _
    "Steg 1 klart!"
Range("C14").Select


Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

MsgBox ("Steg 1 klart")

End Sub
相关问题
最新问题