Sub Btn1_Submit()
Dim varrAddr As Variant
Dim vResult() As Variant
Dim i As Long
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Dim lRow As Long
Application.ScreenUpdating = False
Set copySheet = Worksheets("Batch Record Sheet")
Set pasteSheet = Worksheets("Batch Record Database")
varrAddr = Split("B3,D3,F3,H3,C14,C15,H14,C19,C20,H19,C24,C25,H24,B32,D32,F32,B33,D33,F33,E35," & _
"A54,C54,F54,H54,C55,H55,C57,H57,B62,B63,B64,C64,C63,C64,D62,D63,D64,E62,E63," & _
"E64,F62,F63,F64,G62,G63,G64,H62,H63,H64,I62,I63,I64,B71,D71,F71,B72,D72,F72," & _
"A77,C77,F77,H77,C78,H78,C80,H80,B85,B86,B87,C85,C86,C87,D85,D86,D87,E85,E86," & _
"E87,F85,F86,F87,G85,G86,G87,H85,H86,H87,I85,I86,I87,D105,D106,A112,B112,C112," & _
"E112,G112,H112,A113,B113,C113,E113,G113,H113,A114,B114,C114,E114,G114,H114," & _
"A115,B115,C115,E115,G115,H115,A116,B116,C116,E116,G116,H116,A117,B117,C117," & _
"E117,G117,H117,B124,D124,F124,B125,D125,F125,C127,C129,C133,C134,C135,C133," & _
"C134,C135,D133,D134,D135,E133,E134,E135,F133,F134,F135,G133,G134,G135,H133," & _
"H134,H135,I133,I134,I135,B154,D154,F154,B155,D155,F155,C158,B162,F162,B163," & _
"F163,E165,A170,D170,F170", ",")
ReDim vResult(0 To UBound(varrAddr))
With copySheet
For i = 0 To UBound(vResult)
vResult(i) = .Range(varrAddr(i)).Value
Next i
End With
With pasteSheet
lRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(lRow, "A").Resize(, UBound(vResult) + 1).Value = vResult
End With
End Sub
Artik