2016-02-13 116 views
0

我真的很感謝一些幫助,找到解決我的問題的正確方法。使用VBA重新排列數據

我通過所有工作表試圖循環(除了「表1」和「輸出」。

所有上面提到的工作表包含從A2單元格數據,最後一列和最後一行。我需要複製所有在我的「輸出」工作表中的單元格C2中的循環範圍(一個在另一個下面)

另外我在所有工作表中都有一個唯一編號(需要複製的「工作表1」和「輸出」除外在我的「輸出」工作表中輸入B2,技巧是(我正在努力工作)A1中的值需要在我的「輸出」工作表中複製下來,數字爲A2:我所有循環工作表中的最後一行

下面是我的代碼至今:

Sub EveryDayImShufflingData() 

    Dim ws As Worksheet 
    Dim PasteSheet As Worksheet 
    Dim Rng As Range 
    Dim lRow As Long 
    Dim lCol As Long 
    Dim maxRow As Integer 
    Dim x As String 

    Set PasteSheet = Worksheets("Output") 

    Application.ScreenUpdating = False 

    'Loop through worksheets except "Sheet 1" and "Output" 
    For Each ws In ActiveWorkbook.Worksheets 
     If (ws.Name <> "Sheet1") And (ws.Name <> "Output") And (ws.Visible = True) Then 

      'Select the Worksheet 
      ws.Select 

      'With each worksheet 
      With ws 

       'Declare variables lRow and lCol 
       lRow = .Cells(Rows.Count, 1).End(xlUp).Row 
       lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column 

       'Set range exc. VIN 
       Set Rng = .Range(.Cells(2, 1), .Cells(lRow, lCol)) 

       'Paste the range into "Output" worksheet 
       Rng.Copy 
       PasteSheet.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 

       x = .Cells(1, 1).Value 

       For i = 1 To lRow 
        PasteSheet.Cells(i, 2).End(xlUp).Offset(1, 0) = x 
        maxRow = maxRow + 1 
       Next 

       Application.CutCopyMode = False 
       Application.ScreenUpdating = True 

      End With 
     End If 
    Next ws 
End Sub 

任何援助將好心讚賞

回答

0

試試這個:

Sub EveryDayImShufflingData()  
    Dim ws As Worksheet, copyRng As Range, lRow As Long, lCol As Long, PasteSheet As Worksheet 

    Set PasteSheet = Worksheets("Output") 

    For Each ws In ActiveWorkbook.Worksheets 
     If (ws.Name <> "Sheet1") And (ws.Name <> "Output") And (ws.Visible = True) Then 

      lRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row 
      lCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column 

      Set copyRng = ws.Range(ws.Cells(2, 1), ws.Cells(lRow, lCol)) 

      copyTargetCell = PasteSheet.Cells(Rows.Count, 3).End(xlUp).Row + 1 

      copyRng.Copy Destination:=PasteSheet.Range("C" & copyTargetCell) 

      Worksheets("Output").Range("B" & copyTargetCell & ":B" & (copyTargetCell + copyRng.Rows.Count - 1)) = ws.Range("A1") 
     End If 
    Next ws 
End Sub 
+0

感謝你亞歷克斯P!鍛鍊了魅力。 –

+0

如果我想在代碼中添加另一層複雜性,並且在「Sheet1」中的「輸出」 - INDEX(A2:A和lastrow)中的單元格A2中,MATCH(B2,(B2:B&lastrow,0)輸出「。我怎樣才能實現這一點,並填寫公式到最後一行 –

+0

對不起B2:B&lastrow Sheet1 –