循環代碼以將不同的工作表數據提取到不同的工作表

對於可能是凌亂的代碼和/或簡單的問題，我表示抱歉。循環代碼以將不同的工作表數據提取到不同的工作表

我已經搜索了這個網站和網頁，並嘗試過各種代碼段，但是我的理解力和耐心對於當前的任務來說太有限了。我很感激你更有見識的體驗。現在的問題..：

我想循環一段代碼，以便它可以實現不同的範圍。我從兩張數據開始，其中第二張數據包含大約66列的精製數據，其中前兩列將用於每張新紙張。代碼首先篩選第三列並複製第一列和第三列，創建一個新工作表並粘貼這些值。然後它返回到Sheet2以刪除過濾器併爲第四列執行相同的操作。

由於每次迭代都有重複，例如， 3，4，5 ...我想創建一個可用於循環代碼的變量，並使其更加整潔，並且可以將循環次數限制爲列數 - 2（前兩列）。因此，不是我編寫這段代碼64次，而是將它改爲另一個100列的工作簿，如果可能的話，我想只改變一些變量和範圍。

Sub CopyPaste() 
Dim rg As Range 
Set rg = ActiveSheet.Range("$A$1:$BN$5279") 
rg.AutoFilter Field:=3, Criteria1:="<>" 
Union(Columns(1), Columns(2), Columns(3)).Select 
Selection.Copy 
Sheets.Add After:=Sheets(Sheets.Count) 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
:=False, Transpose:=False 
Sheets("Sheet2").Select 
rg.AutoFilter Field:=3 
rg.AutoFilter Field:=4, Criteria1:="<>" 
Union(Columns(1), Columns(2), Columns(4)).Select 
Selection.Copy 
Sheets.Add After:=Sheets(Sheets.Count) 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
:=False, Transpose:=False 
Sheets("Sheet2").Select 
rg.AutoFilter Field:=4 
rg.AutoFilter Field:=5, Criteria1:="<>" 
Union(Columns(1), Columns(2), Columns(5)).Select 
Selection.Copy 
Sheets.Add After:=Sheets(Sheets.Count) 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
:=False, Transpose:=False 
Sheets("Sheet2").Select 
rg.AutoFilter Field:=5 
End Sub

謝謝瑞奇

來源

2017-07-27 Ricky Shah

像這樣的東西應該適合你。您可以根據需要調整for循環以遍歷所需的所有列。這避免了選擇片段，在每次迭代完成時重置過濾器，並且容易調整列數的任何變化。它還將以編程方式查找最後一行，而不是硬編碼的範圍。

Sub CopyPaste() 
    Dim rg As Range 
    Dim LastRow As Long 
    LastRow = Sheets("Sheet2").Range("A1").SpecialCells(xlCellTypeLastCell).Row 
    Set rg = Sheets("Sheet2").Range("A1:BN" & LastRow) 
     For i = 3 To 5 
      rg.AutoFilter Field:=i, Criteria1:="<>" 
      Union(Columns(1), Columns(2), Columns(i)).Copy 
      Sheets.Add After:=Sheets(Sheets.Count) 
      Sheets(Sheets.Count).Cells(1, 1).PasteSpecial Paste:=xlPasteValues 
      rg.AutoFilter 
     Next i 
End Sub

來源

2017-07-27 12:53:14

謝謝克里斯。這工作，除了我需要添加：表（「Sheet2」）。選擇之前rg.Autofilter。 –

有可能是一個更好的方式來處理這一點，但只是把它放在一個循環，試試下面的代碼：

Sub CopyPaste() 

Dim rg As Range: Set rg = ActiveSheet.Range("$A$1:$BN$5279") 

For iC = 3 To 64 
    rg.AutoFilter Field:=iC, Criteria1:="<>" 
    Union(Columns(1), Columns(2), Columns(3)).Select 
    Selection.Copy 
    Sheets.Add After:=Sheets(Sheets.Count) 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
    Sheets("Sheet2").Select 
    rg.AutoFilter Field:=iC 
Next

末次

來源

2017-07-27 12:31:19 Zac

感謝您的回答Zac。這也工作，除了錯過了列（3）>>列（iC）的變化。 –

循環代碼以將不同的工作表數據提取到不同的工作表

回答

相關問題