N
NadiaR via OfficeKB.com
I have something that almost works...but I can't get it to copy the entire
Column AD, where am i making a mistake.
Thanks in advance,
Nadia
'Take ComboBox choice
Dim MyMonth As String
MyMonth = ComboBox1.Value
'loop Calc columns
Dim Calc_Col As Integer
Calc_Col = 1
Do While Worksheets("Calculation").Cells(5, Calc_Col).Value <> MyMonth
Calc_Col = Calc_Col + 1
Loop
'loop Calc rows
Dim Calc_Row As Integer
Calc_Row = 5
Do While Trim(Worksheets("Calculation").Cells(Calc_Row, Calc_Col).Value) <>
""
Calc_Row = Calc_Row + 1
Loop
Calc_Row = Calc_Row - 1
'loop Data Columns
Dim Data_Col As Integer
Data_Col = 1
Do While Worksheets("Data").Cells(5, Data_Col).Value <> MyMonth
Data_Col = Data_Col + 1
Loop
'translate Calc_Col
Dim Calc_ColL As String
Select Case Calc_Col
Case 30: Calc_ColL = "AD"
Case 31: Calc_ColL = "AE"
Case 32: Calc_ColL = "AF"
Case 33: Calc_ColL = "AG"
Case 34: Calc_ColL = "AH"
Case 35: Calc_ColL = "AI"
Case 36: Calc_ColL = "AJ"
Case 37: Calc_ColL = "AK"
Case 38: Calc_ColL = "AL"
Case 39: Calc_ColL = "AM"
Case 40: Calc_ColL = "AN"
Case 41: Calc_ColL = "AO"
Case 42: Calc_ColL = "AP"
Case 43: Calc_ColL = "AQ"
Case 44: Calc_ColL = "AR"
Case 45: Calc_ColL = "AS"
Case 46: Calc_ColL = "AT"
End Select
'Copy & Paste value
Dim MyRange As String
MyRange = Calc_ColL & "6:" & Calc_ColL & Calc_Row
'Worksheets("Calculation").Range(Cells(6, Calc_Col), Cells(Calc_Row, Calc_Col)
).Select
Worksheets("Calculation").Select
Worksheets("Calculation").Range(MyRange).Select
Selection.Copy
Worksheets("Data").Select
Worksheets("Data").Cells(6, Data_Col).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Column AD, where am i making a mistake.
Thanks in advance,
Nadia
'Take ComboBox choice
Dim MyMonth As String
MyMonth = ComboBox1.Value
'loop Calc columns
Dim Calc_Col As Integer
Calc_Col = 1
Do While Worksheets("Calculation").Cells(5, Calc_Col).Value <> MyMonth
Calc_Col = Calc_Col + 1
Loop
'loop Calc rows
Dim Calc_Row As Integer
Calc_Row = 5
Do While Trim(Worksheets("Calculation").Cells(Calc_Row, Calc_Col).Value) <>
""
Calc_Row = Calc_Row + 1
Loop
Calc_Row = Calc_Row - 1
'loop Data Columns
Dim Data_Col As Integer
Data_Col = 1
Do While Worksheets("Data").Cells(5, Data_Col).Value <> MyMonth
Data_Col = Data_Col + 1
Loop
'translate Calc_Col
Dim Calc_ColL As String
Select Case Calc_Col
Case 30: Calc_ColL = "AD"
Case 31: Calc_ColL = "AE"
Case 32: Calc_ColL = "AF"
Case 33: Calc_ColL = "AG"
Case 34: Calc_ColL = "AH"
Case 35: Calc_ColL = "AI"
Case 36: Calc_ColL = "AJ"
Case 37: Calc_ColL = "AK"
Case 38: Calc_ColL = "AL"
Case 39: Calc_ColL = "AM"
Case 40: Calc_ColL = "AN"
Case 41: Calc_ColL = "AO"
Case 42: Calc_ColL = "AP"
Case 43: Calc_ColL = "AQ"
Case 44: Calc_ColL = "AR"
Case 45: Calc_ColL = "AS"
Case 46: Calc_ColL = "AT"
End Select
'Copy & Paste value
Dim MyRange As String
MyRange = Calc_ColL & "6:" & Calc_ColL & Calc_Row
'Worksheets("Calculation").Range(Cells(6, Calc_Col), Cells(Calc_Row, Calc_Col)
).Select
Worksheets("Calculation").Select
Worksheets("Calculation").Range(MyRange).Select
Selection.Copy
Worksheets("Data").Select
Worksheets("Data").Cells(6, Data_Col).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub