Need Help Streamlining Code

[zendog1960]

The following code does what I want for two rows but I have ten rows of data so I would like to streamline this down to one block of code that can do this work for all ten lines.

Any help would be appreciated!

<code>
Sub Copyinfo1()
Dim BottleDate As String
BottleDate = Range("AB5").Value

If BottleDate <> "" Then

'Select, copy, and paste Wine Name
Range("AD5").Select
Selection.Copy
Sheets("Finished Wines").Select
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Wines in Production").Select
Application.CutCopyMode = False

'Select, copy, and paste Wine Bottled Date
Sheets("Wines in Production").Select
Range("AB5").Select
Selection.Copy
Sheets("Finished Wines").Select
Range("C5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Select, copy, and paste # of Bottles Made
Sheets("Wines in Production").Select
Range("Z5").Select
Selection.Copy
Sheets("Finished Wines").Select
Range("D5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Select, copy, and paste Alcohol by Volume
Sheets("Wines in Production").Select
Range("Y5").Select
Selection.Copy
Sheets("Finished Wines").Select
Range("E5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Wines in Production").Select
Range("AB2").Select

End If

End Sub

Sub Copyinfo2()
Dim BottleDate As String
BottleDate = Range("AB7").Value

If BottleDate <> "" Then

'Select, copy, and paste Wine Name
Range("AD7").Select
Selection.Copy
Sheets("Finished Wines").Select
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Wines in Production").Select
Application.CutCopyMode = False

'Select, copy, and paste Wine Bottled Date
Range("AB7").Select
Selection.Copy
Sheets("Finished Wines").Select
Range("C6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Select, copy, and paste # of Bottles Made
Sheets("Wines in Production").Select
Range("Z7").Select
Selection.Copy
Sheets("Finished Wines").Select
Range("D6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

'Select, copy, and paste Alcohol by Volume
Sheets("Wines in Production").Select
Range("Y7").Select
Selection.Copy
Sheets("Finished Wines").Select
Range("E6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Wines in Production").Select
Range("AB2").Select

End If

End Sub
</code>

 

[WarPigl3t]

Sub myInputs()
     shtMain = "Wines in Production"
     shtFinishedWines = "Finished Wines"
     firstRow = 5
     lastRow = Sheets(shtMain).Range("AB" & Rows.Count).End(xlUp).Row
     r = firstRow
     Do Until r > lastRow
          printRow = Sheets(shtFinishedWines).Range("B" & Rows.Count).End(xlUp).Row + 1
          BottleDate = Sheets(shtMain).Range("AB" & r).Value
          Call myMacro(shtMain, shtFinishedWines, BottleDate, r, printRow)
          r = r + 2
     Loop
   
     Sheets(shtMain).Range("C:C").ClearContents
     Sheets(shtMain).Range("E:E").ClearContents
     Sheets(shtMain).Range("G:G").ClearContents
     Sheets(shtMain).Range("I:I").ClearContents
     Sheets(shtMain).Range("K:K").ClearContents
     Sheets(shtMain).Range("M:M").ClearContents
     Sheets(shtMain).Range("O:O").ClearContents
     Sheets(shtMain).Range("Q:Q").ClearContents
     Sheets(shtMain).Range("S:S").ClearContents
     Sheets(shtMain).Range("T:T").ClearContents
     Sheets(shtMain).Range("U:U").ClearContents
     Sheets(shtMain).Range("V:V").ClearContents
     Sheets(shtMain).Range("W:W").ClearContents
     Sheets(shtMain).Range("Z:Z").ClearContents
     Sheets(shtMain).Range("AA:AA").ClearContents
     Sheets(shtMain).Range("AB:AB").ClearContents
     Sheets(shtMain).Range("AC:AC").ClearContents
     
End Sub

Sub myMacro(shtMain, shtFinishedWines, BottleDate, inputRow, outputRow)
     If BottleDate <> "" Then
          Sheets(shtFinishedWines).Range("B" & outputRow).Value = Sheets(shtMain).Range("AD" & inputRow).Value
          Sheets(shtFinishedWines).Range("C" & outputRow).Value = Sheets(shtMain).Range("AB" & inputRow).Value
          Sheets(shtFinishedWines).Range("D" & outputRow).Value = Sheets(shtMain).Range("Z" & inputRow).Value
          Sheets(shtFinishedWines).Range("E" & outputRow).Value = Sheets(shtMain).Range("Y" & inputRow).Value
     End If
End Sub

 

[WarPigl3t]

Maybe someone can help you streamline the clear contents code. You should create a new thread for that question.

 

[My Aswer Is This]

Shortened code to clear contents:

Sub Clear_Contents()
    Dim shtMain As String
    shtMain = "Wines in Production"

     With Sheets(shtMain)
     .Range("C1,E1,G1,I1,K1,M1,O1,Q1,S1,T1,U1,V1,W1,Z1,AA1,AB1,AC1").EntireColumn.ClearContents
     End With
End Sub