僅當數據存在時複製多行數據

我有一個名爲Data Sheet的電子表格，它通過公式從其他工作表中收集數據並完美工作。我需要一個宏來複制多行數據，以便我可以粘貼到單獨的工作簿中。僅當數據存在時複製多行數據

我有30行數據範圍從A3:EI3到A32:EI32。如果數據可見並輸入數據，則會從1到30張其他表中收集這些數據。這是棘手的部分：我只想收集可見表格中的數據。

以下是我正在尋找的流程示例：Sheet 1始終可見，永不隱藏。 Sheet 2,Sheet 3和Sheet 4是可見的，但Sheet 5到Sheet 30仍然隱藏。 Data Sheet已經從可見表中收集數據，但其餘行（表5-30）都在數據單元中顯示0。

我現在想運行一個宏，將從Data SheetRow 3中的數據複製（複製到剪貼板）（代表Sheet 1），Row 4（代表Sheet 2）等，讓我貼到下一個可用的行中的另一個工作簿。

以下是適用於單行數據的代碼。

VBA代碼：

Sub CopyDataSheet() 
' 
' CopyDataSheet Macro 

' 
Application.ScreenUpdating = False 
Sheets("Data Sheet").Visible = True 


Sheets("Data Sheet").Select 
Rows("3:3").Select 
Selection.Copy 
Rows("1:1").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Range("E1:EF1").Select 
Application.CutCopyMode = False 
Selection.NumberFormat = "0" 
Rows("1:1").Select 
Range("B1").Activate 
Selection.Copy 
Sheets("Sheet 1").Select 
Range("a38").Select 

Sheets("Data Sheet").Visible = True 

Application.ScreenUpdating = True 

    MsgBox "YOU HAVE CAPTURED ALL ENTERED DATA..." & _ 
vbCrLf & vbCrLf & "CLICK OK" _ 
& vbCrLf & vbCrLf & "PASTE INTO NEXT EMPTY LINE OF DATA SHEET", _ 
    vbInformation, "" 
End Sub

來源

2009-12-22 Leroy Frieling

爲什麼標記爲ms-access而不是Excel？ – Fionnuala 2009-12-22 21:53:13

好點...這個問題的編輯是一團糟。編輯代碼的人在代碼塊中的一個不利位置留下了「在此輸入代碼」。我已經爲Excel重新制作了它，這顯然是這樣的。 – 2009-12-23 15:22:37

Option Explicit 

Public Sub CollectData() 
    Dim wsCrnt As Excel.Worksheet 
    Dim wsDest As Excel.Worksheet 
    Dim lRowCrnt As Long 
    Dim lRowDest As Long 
    On Error GoTo Err_Hnd 
    ToggleInterface False 
    Set wsDest = ThisWorkbook.Worksheets("Data Sheet") 
    lRowDest = wsDest.UsedRange.Rows.Count + 1& 
    For Each wsCrnt In ThisWorkbook.Worksheets 
     If wsCrnt.Visible = xlSheetVisible Then 
      If Not wsCrnt Is wsDest Then 
       For lRowCrnt = 1& To 30& 
        If Excel.WorksheetFunction.CountA(wsCrnt.Rows(lRowCrnt)) Then 
         wsCrnt.Rows(lRowCrnt).Copy 
         wsDest.Rows(lRowDest).PasteSpecial xlPasteValues 
         lRowDest = lRowDest + 1 
        End If 
       Next 
      End If 
     End If 
    Next 
Exit_Proc: 
    On Error Resume Next 
    ToggleInterface True 
    Exit Sub 
Err_Hnd: 
    MsgBox Err.Description, vbCritical Or vbMsgBoxHelpButton, _ 
     "Error: " & Err.Number, Err.HelpFile, Err.HelpContext 
    Resume Exit_Proc 
End Sub 

Private Sub ToggleInterface(ByVal interfaceOn As Boolean) 
    With Excel.Application 
     .Cursor = IIf(interfaceOn, xlDefault, xlWait) 
     .StatusBar = IIf(interfaceOn, False, "Working...") 
     .EnableEvents = interfaceOn 
     .Calculation = IIf(interfaceOn, xlCalculationAutomatic, xlCalculationManual) 
     .ScreenUpdating = interfaceOn 
     .EnableCancelKey = Abs(interfaceOn) 
    End With 
End Sub

來源

2009-12-23 16:30:49 Oorang

我不是100％肯定它是什麼，你正在嘗試做的，但我想我可以提供一些代碼片段，可以幫助你。

隔着薄片這將循環在活動工作簿，並允許您根據紙張是否是可見的做一些事情：

j = ActiveWorkbook.Sheets.Count 

For i = 1 To j 
    Select Case Sheets(i).Visible 
    Case xlSheetVisible 
     'Do something if the sheet is visible 
    Case Else 
     'Do something when the sheet is not visible 
    End Select 
Next i

爲了得到下一個可用行有很多不同的方式。最簡單的一種是簡單：

next_row =範圍（「A」 & Rows.Count）.END（xlUp）.row + 1

這假定列A總是有任何數據行中的值。如果不是這種情況，你可以試試這個：

next_row = ActiveSheet.UsedRange.Rows.Count + 1

既不是防彈，但它至少應該給你一個開始。

來源

2009-12-23 16:52:17

僅當數據存在時複製多行數據

回答

相關問題