由于每次原始数据的名称都不一样，如何每次自动获取名称？

棋行天下黄

由于每次原始数据的名称都不一样，如何每次自动获取名称？Sub Macro1()
'
' Macro1 Macro
' 宏由 黄勇 录制，时间: 2009-6-9
'
' 快捷键: Ctrl+k
'
    ChDir "C:\Documents and Settings\Administrator\My Documents\宏标卡"
    Workbooks.Open Filename:= _
        "C:\Documents and Settings\Administrator\My Documents\宏标卡\门店标卡（武汉）.xls"
    ActiveWindow.SmallScroll Down:=-48
    Range("A1:C42").Select
    Range("A40").Activate
    Selection.Copy
    Windows("原始数据.xls").Activate
    Sheets.Add
    ActiveSheet.Paste
    Windows("门店标卡（武汉）.xls").Activate
    Sheets("品类对应部门").Select
    ActiveWindow.SmallScroll Down:=-21
    Range("A1:C43").Select
    Range("C15").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("原始数据.xls").Activate
    Sheets.Add
    ActiveSheet.Paste
    Sheets("原始数据").Select
    Windows("门店标卡（武汉）.xls").Activate
    ActiveWindow.Close
End Sub
需要完整代码代替上面原始数据的名字，即任意文件名按ctrl+k即可，谢谢

方漠

Here is a sample for you, try to get the variant with Activesheet.name/activeworkbook.name/activewindow.name.


Sub FormatBalance()

Dim Str As String
Dim ab As Variant
Dim Lrow As Long, I As Long, T As Long
Dim Fcl As Range

Str = Workbooks.Application.GetOpenFilename
ab = Str
  If ab = False Then
   MsgBox "You didn't select the TXT file. Cancelling...", vbExclamation, "Your Company Name"
  Else
      Application.DisplayAlerts = False
      Application.ScreenUpdating = False

    Workbooks.OpenText Filename:=Str, Origin:=-536, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1 _
        ), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), TrailingMinusNumbers:=True


Lrow = Range("A65536").End(xlUp).Row
T = 8
For I = 8 To Lrow                            'Remove the Redundant Line
    If Left(Range("A" & I), 9) = "---------" Then
       Rows(I & ":" & I).Delete
       I = I - 1
    End If
   
    If I > 25 And Left(Range("A" & I), 3) <> "832" Then
           Rows(I & ":" & I).Delete
           I = I - 1
    End If
   
    T = T + 1
    If T > Lrow Then Exit For
Next I

For Each Fcl In ActiveSheet.UsedRange   'Remove the Redundant Blank
Fcl = Trim(Fcl.Value)
Next


    Range("A9:A10").Merge
    Range("B9:B10").Merge
    Range("C9:C10").Merge
    Range("L910").Merge
    Range("A910").Select
   
    With Selection.Interior
        .ColorIndex = 12
        .Pattern = xlSolid
    End With

    With Selection.Font
        .Name = "Arial"
        .Size = 10
        .ColorIndex = 2
        .Bold = True
    End With
   
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    Columns("A:A").ColumnWidth = 9.5
    Columns("B").EntireColumn.AutoFit
   
    I = Range("C65536").End(xlUp).Row
   
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight
    Range("H9:H10").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    Selection.Merge
    ActiveCell.FormulaR1C1 = "Diff +/-"
    Range("H11:H" & I).Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
    Selection.FillDown
   
    Range("M910").Select
    Selection.FillRight
    Range("N9:N10").FormulaR1C1 = "Remark"
    Range("O9:O10").FormulaR1C1 = "Found date"
    Range("910").FormulaR1C1 = "Status"
    Range("11" & I).Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""","""",TODAY()-RC[-1])"
    Selection.FillDown
    Columns("N:N").ColumnWidth = 15
    Columns("O:O").ColumnWidth = 12
    Columns("D:E").EntireColumn.Hidden = True
    Columns("M:M").EntireColumn.Hidden = True
    Columns("I:L").ColumnWidth = 10
    Range("A11").Select
      
     Application.DisplayAlerts = True
     Application.ScreenUpdating = False

End If

End Sub

棋行天下黄

你是我见过的真正的高手，佩服得六体投地，在你的指导下，我已将宏重新修改，自动打开宏标卡（在你的电脑上路径要修改一下），可以识别不同的文件名，但是运行错误在Selection.AutoFilter处，不知所以，请不吝赐教再指点，最好是全部源码，你真是个好人！！
Sub Macro1()
'
' Macro1 Macro
' 宏由 黄勇 录制，时间: 2009-6-10
'
' 快捷键: Ctrl+k
Dim strA As String
    strA = ThisWorkbook.Name
   
     ChDir "C:\Documents and Settings\Administrator\My Documents\宏标卡"
    Workbooks.Open Filename:= _
        "C:\Documents and Settings\Administrator\My Documents\宏标卡\门店标卡（武汉）.xls"
      
      Windows(strA).Activate
      Range("A2").Select
    Selection.Insert Shift:=xlDown
    Selection.AutoFilter
    Selection.AutoFilter Field:=2, Criteria1:="1"
    Cells.Select
    Range("A2").Activate
    Selection.Copy
  
    Sheets.Add
    ActiveSheet.Paste
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'[门店标卡（武汉）.xls]品类对应部门'!C1:C2,2,0)"
    Selection.AutoFill Destination:=Range("B2:B100"), Type:=xlFillDefault
    Range("B2:B100").Select
    ActiveWindow.SmallScroll Down:=-84
    Range("B1").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=2, Criteria1:="<>#N/A", Operator:=xlAnd
    Cells.Select
    Range("B1").Activate
    Selection.Copy
    Sheets("Sheet1").Select
    Sheets.Add
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("Sheet2").Select
    Sheets.Add
    Application.CutCopyMode = False
    Selection.Consolidate Sources:= _
        "'Sheet2'!R1C2:R148C136" _
        , Function:=xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=False
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'[门店标卡（武汉）.xls]品类对应部门'!C2:C3,2,0)"
    Selection.AutoFill Destination:=Range("B2:B12"), Type:=xlFillDefault
    Range("B2:B12").Select
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "品类"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "序号"
   Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin
    Rows("1:22").Select
    Selection.Copy
    Sheets.Add
    Sheets("Sheet4").Select
    ActiveWindow.SmallScroll Down:=-15
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Range("A1").Select
    Sheets("Sheet4").Select
    Sheets.Add
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "='[门店标卡（武汉）.xls]门店顺序'!RC"
    Range("A1").Select
    Selection.AutoFill Destination:=Range("A1:C1"), Type:=xlFillDefault
    Range("A1:C1").Select
    Selection.AutoFill Destination:=Range("A1:C100"), Type:=xlFillDefault
    Range("A1:C100").Select
    ActiveWindow.SmallScroll Down:=-135
    Sheets("Sheet4").Select
    Range("B1:K1").Select
    Selection.Copy
    Sheets("Sheet5").Select
    Range("D1").Select
    ActiveSheet.Paste
    Range("D2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,2,0)"
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,2,0)/10000"
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:M2"), Type:=xlFillDefault
    Range("D2:M2").Select
    ActiveWindow.ScrollColumn = 1
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,3,0)/10000"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,4,0)/10000"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,5,0)/10000"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,6,0)/10000"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,7,0)/10000"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,8,0)/10000"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,9,0)/10000"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,10,0)/10000"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Sheet4!C1:C11,11,0)/10000"
    Range("D2:M2").Select
    Range("M2").Activate
    ActiveWindow.ScrollColumn = 4
    Selection.AutoFill Destination:=Range("D2:M100"), Type:=xlFillDefault
    Range("D2:M100").Select
    Cells.Select
    Range("M2").Activate
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.SmallScroll Down:=-126
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    ActiveWindow.ScrollColumn = 1
    With Selection.Font
        .Name = "宋体"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.NumberFormatLocal = "0.00_ "
    ActiveWindow.ScrollColumn = 1
    Columns("A:C").Select
    Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.SmallScroll ToRight:=2
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "合计"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-10]:RC[-1])"
    Range("N2").Select
    Selection.AutoFill Destination:=Range("N2:N42"), Type:=xlFillDefault
   
    Range("A43").Select
    ActiveCell.FormulaR1C1 = "合计"
    Range("D43").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-41]C:R[-1]C)"
    Range("D43").Select
    ActiveWindow.SmallScroll Down:=3
    Range("D43").Select
    Selection.AutoFill Destination:=Range("D43:N43"), Type:=xlFillDefault
    Range("D43:N43").Select
    ActiveWindow.SmallScroll Down:=-42
    ActiveWindow.ScrollColumn = 1
   
    Sheets("Sheet5").Select
    Sheets("Sheet5").Name = "报表"
    Sheets("Sheet4").Select
    ActiveWindow.SelectedSheets.Visible = False
    ActiveWindow.SelectedSheets.Visible = False
    ActiveWindow.SelectedSheets.Visible = False
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("报表").Select
End Sub

pureshadow

放到表中测试了，没有发生问题。
不过录出来的代码有时会因为工作表未指定而产生错误了。
本来想帮你改一下，后来仔细看了一下，楼主不就是要做到个转置的效果么，这个似乎用不着这么复杂的代码，也许是我眼花……