在宏中選擇一個字段並將其切出循環

我需要在Excel工作表中選擇一個單元格（表格）的字段，將所選內容剪切出來，然後將其粘貼到新的單獨工作表中。在這張工作表中有幾千張桌子，我想將它們自動剪切並粘貼到單獨的工作表中。這些表格由帶＃符號的單元格分隔，但我不知道它是否有幫助。當我錄這個宏的第一個表它運行的是這樣的：在宏中選擇一個字段並將其切出循環

Sub Makro1() 
Range("A2:AB20").Select 
Selection.Cut 
Sheets.Add After:=Sheets(Sheets.Count) 
ActiveSheet.Paste 
End Sub

現在我想打一個循環會經歷整個工作表，動態地選擇每這將＃號的分隔表列A並粘貼到新表中。我不想選擇確切範圍A2：AB20，但我想根據此＃號進行選擇。

下面是截圖 enter image description here

來源

2013-02-25 DDEX

您能否提供一張屏幕截圖，表格是如何分開的？只是在評論中發佈鏈接，有人會將其包含在帖子中... – 2013-02-25 11:38:08

我不明白autofilter如何能夠提供幫助....我需要剪切（或複製）行9點15分，28點32分等並將它們中的每一個粘貼到新的單頁中。 – DDEX 2013-02-25 12:57:54

對不起，監督「新表」部分。我的錯！ – 2013-02-25 13:02:28

試試看看這個代碼。您可能需要根據您的需要調整前4個常量：

Sub CopyToSheets() 
    Const cStrSourceSheet As String = "tabulky" 
    Const cStrStartAddress As String = "A2" 
    Const cStrSheetNamePrefix As String = "Result" 
    Const cStrDivider As String = "#" 

    Dim rngSource As Range 
    Dim lngMaxRow As Long, lngLastDividerRow As Long, lngRowCount As Long 
    Dim wsTarget As Worksheet 
    Dim lngCounter As Long 

    Application.ScreenUpdating = False 
    Application.Calculation = xlCalculationManual 

    'Delete old worksheets 
    Application.DisplayAlerts = False 
    For Each wsTarget In Sheets 
     If InStr(wsTarget.Name, cStrSheetNamePrefix) Then wsTarget.Delete 
    Next 
    Application.DisplayAlerts = True 

    With Sheets(cStrSourceSheet) 
     Set rngSource = .Range(cStrStartAddress) 
     lngLastDividerRow = rngSource.Row 
     lngMaxRow = .Cells(Rows.Count, 1).End(xlUp).Row 
    End With 

    Set rngSource = rngSource.Offset(1) 
    While rngSource.Row < lngMaxRow 
     If rngSource = cStrDivider Then 
      lngCounter = lngCounter + 1 
      Set wsTarget = Sheets.Add(After:=Sheets(Sheets.Count)) 
      wsTarget.Name = cStrSheetNamePrefix & " " & lngCounter 
      lngRowCount = rngSource.Row - lngLastDividerRow - 1 
      rngSource.Offset(-lngRowCount - 1).Resize(lngRowCount).EntireRow.Copy _ 
       wsTarget.Range("A1").Resize(lngRowCount).EntireRow 

      lngLastDividerRow = rngSource.Row 
     End If 
     Set rngSource = rngSource.Offset(1) 
    Wend 

    Application.ScreenUpdating = True 
    Application.Calculation = xlCalculationAutomatic 

End Sub

來源

2013-02-25 13:31:59

謝謝，那很完美 – DDEX 2013-02-25 13:33:55

這將填充你的所有的散列值索引的數組。這應該爲您提供需要收集適當數據的參考點。

Sub FindHashmarksInColumnA() 

    Dim c As Range 
    Dim indices() As Long 
    Dim i As Long 
    Dim iMax As Double 
    Dim ws As Worksheet 

    Set ws = ActiveSheet 

    i = 0 
    iMax = Application.WorksheetFunction.CountIf(ws.Range("A:A"), "#") 
    ReDim indices(1 To iMax) 

    For Each c In ws.UsedRange.Columns(1).Cells 
     If c.Value = "#" Then 
      i = i + 1 
      indices(i) = c.Row 
     End If 
    Next c 

    ' For each index, 
    ' Count rows in table, 
    ' Copy data offset from reference of hashmark, 
    ' Paste onto new sheet in appropriate location etc. 

End Sub

來源

2013-02-25 13:14:22 JustinJDavies

在宏中選擇一個字段並將其切出循環

回答

相關問題