將基於條件的值從一張表複製到另一個工作簿

我已經編寫了一些代碼，它將基於行＃的代碼中的每個項分配給一個代碼。我想從那裏做的是從每行中選擇一個與所選代碼相對應的所有信息，然後將其粘貼到另一個工作簿中。我一直有一些麻煩。下面的代碼：在那裏我遇到的問題將基於條件的值從一張表複製到另一個工作簿

wbLSHP.Activate 
For Each cell In CodeRange 
    If cell = "1" Then 
     Range(ActiveCell.Offset(0, -5), ActiveCell.Offset(0, 20)).Select 
     Selection.Copy 
     wbTEST.Sheets("Sheet1").Cells(PasteRow, 1).PasteSpecial xlPasteValues 
     PasteRow = PasteRow + 1 
    Else 
    End If 
Next cell 

End Sub

第一個問題是對於循環不復制正確的範圍內「CodeRange」

Sub LSHP_Distribute() 

Dim wbLSHP As Workbook 
Dim wsLSHP As Worksheet 
Dim CodeRange As Range 
Dim FirstRow As Long 
Dim LastRow As Long 

Dim wbTEST As Workbook 

Set wbLSHP = ActiveWorkbook 
Set wsLSHP = wbLSHP.Sheets("Sheet1") 

'Generate codes for newly added items 
Application.ScreenUpdating = False            
'Turn off screen updating 

With wsLSHP 
    FirstRow = .Range("F3").End(xlDown).Row + 1 
    LastRow = .Range("B6", .Range("B6").End(xlDown)).Rows.Count + 5 
    Set CodeRange = .Range("$F$" & FirstRow, "$F$" & LastRow) 
End With 

For Each cell In CodeRange 
    If cell = "" Then 
     If cell.Row Mod 3 = 0 Then 
      cell.Value = "1" 
     ElseIf cell.Row Mod 3 = 1 Then 
      cell.Value = "2" 
     ElseIf cell.Row Mod 3 = 2 Then 
      cell.Value = "3" 
     Else 
     End If 
    End If 
Next cell 

'Open Spreadsheets to Distribute Items 
Dim PasteRow As Long 
Dim i As Integer 
Set wbTEST = Workbooks.Open(Filename:="V:\Test.xlsx") 

PasteRow = wbTEST.Sheets("Sheet1").Range("B6").End(xlDown).Row + 1

下面是，第二個問題是，它在出現自動化錯誤之前只複製一次。讓我知道你是否有任何問題，或知道更有效的方式來編寫這段代碼。

非常感謝您的時間！

來源

2017-10-20 Dustin Burns

爲什麼不將所有項目移動到新的工作簿，然後運行代碼以刪除不必要的項目？應該節省一些心痛 – Cyril

在你最後一個循環導致你的問題，你突然提到'ActiveCell'，但它不清楚這是什麼。它應該是「細胞」嗎？其次，在複製之後，您將'PasteRow'增加1，但您複製的範圍超過一行。 – SJR

您的範圍定義爲在F3開始，並在BSomething結束，但您只存儲到CodeRange F列。

Set CodeRange = .Range("$F$" & FirstRow, "$F$" & LastRow)

嘗試使用：

Set CodeRange = .Range("$B$" & FirstRow, "$F$" & LastRow)

我建議，而不是複製和粘貼，賦值給一個變量，把變量的值上wbTEST。

來源

2017-10-20 19:41:48

將基於條件的值從一張表複製到另一個工作簿

回答

相關問題