只循环选定的工作表进行几个步骤
我有一个Excel文件，其中包含几张工作表，我必须从一列切到另一列。
当我在一个特定的工作表上使用代码时，它完美的工作，但我已经尝试使用例如Sheets（数组（“thisSheet”，“ThatSheet”））select和部分工作，因为在行131后，在错误的方向切割数据，这是奇怪的。 但是，不知道如何解决这个问题。
你能帮我用代码吗？ 我会很欣赏它。 在评论中，您只能find特定列的名称，所以请简单地填写它。
Sub TABFixLoop_Main() ' TABFix Macro Loop Core Scratch ' === Declaces which tabs are in the loop ======== ' === Exceptions: ES20, IT40, IT43, IT44, IT45, PT20 === Application.ScreenUpdating = False Dim ws As Worksheet Dim Sheets As Range Set Sheets = Sheets(Array("BE00", "CH10", "CZ00", "DK00", "ES00", "FI00", "IT00", "LU30", "NL00", "NO00", "PT00", "SE00")) For Each ws In Sheets Do ' Fit the columns size ws.Activate ws.Columns.AutoFit ' Putting value ranges in correct places: ' MMDoc # Range("P5").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Range("N5").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ws.Columns("N:N").Select Selection.NumberFormat = "0" Range("P5").Select Range(Selection, Selection.End(xlDown)).Select Application.CutCopyMode = False Selection.ClearContents ' Age Range("Q5").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Range("O5").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Range("Q5").Select Range(Selection, Selection.End(xlDown)).Select Application.CutCopyMode = False Selection.ClearContents ' PO Vendor Range("R5").Select Range(Selection, Selection.End(xlDown)).Select Selection.Cut Application.CutCopyMode = False Selection.Copy Range("P5").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Range("P5").NumberFormat = "0" Range("R5").Select Range(Selection, Selection.End(xlDown)).Select Application.CutCopyMode = False Selection.ClearContents ' Business Area Range("S5").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Range("R5").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Range("S5").Select Range(Selection, Selection.End(xlDown)).Select Application.CutCopyMode = False Selection.ClearContents ' Remove empty columns ws.Columns("S:T").Select Selection.Delete Shift:=xlToLeft ' Add formula to count aging ranges Range("U5").Select ActiveCell.FormulaR1C1 = "=+IF(RC[-6]<=30,""0-30"",IF(RC[-6]<=60,""31-60"",IF(RC[-6]<=90,""61-90"",IF(RC[-6]<=120,""91-120"",IF(RC[-6]<=180,""121-180"",IF(RC[-6]<=365,""181-365"",IF(RC[-6]>365,"">365"","""")))))))" Range(Selection, Selection.End(xlDown)).Select Selection.FillDown Loop Until ws = Sheets(Sheets.Count).Active Application.ScreenUpdating = True End Sub Sub test() Dim ws As Worksheet For Each ws In Worksheets Select Case ws.Name Case "BE00", "CH10", "CZ00", "DK00", "ES00", "FI00", "IT00", "LU30", "NL00", "NO00", "PT00", "SE00" ws.Columns.AutoFit shiftdata ws, "P", "N" shiftdata ws, "Q", "O" shiftdata ws, "R", "P" With ws.Range("U5") .FormulaR1C1 = "=+IF(RC[-6]<=30,""0-30"",IF(RC[-6]<=60,""31-60"",IF(RC[-6]<=90,""61-90"",IF(RC[-6]<=120,""91-120"",IF(RC[-6]<=180,""121-180"",IF(RC[-6]<=365,""181-365"",IF(RC[-6]>365,"">365"","""")))))))" .Copy Destination := ws.Range(.Address & ":" & .End(xlDown).Address) End With Case Else End Select Next ws End Sub Sub shiftdata(ws As Worksheet, strFrom As String, StrTo As String) Dim r As Range Set r = ws.Range(strFrom & "5:" & strFrom & ws.Range(strFrom & "5").End(xlDown).Row) r.Copy ws.Range(StrTo & "5").PasteSpecial xlPasteValues r.ClearContents End Sub