Combine multiple macros having similar procedure

[paneliyadhruv]

Dear All,

I have repeat data macro. Based on my requirement i have created multiple macro for selecting various ranges and output.
I need expert help to combine all macros in to single macro. My data start from columns A to CV.
for eg. First macro range A1 to A10 having text and b1 to b10 having numerical value for number of times repeat and output in column EA1
For second marco range b1 to b10 having text and c1 to c10 having numerical value for number of times repeat and output in column EB1. and so on till CV column.

Macro added for your valuable inputs.


Thank for your time and help in advance.

Private Sub RepeatData1()

On Error Resume Next
With Worksheets("Calc2")
    .Activate
Dim a As Variant, c As Variant
Dim i As Long, ii As Long, N As Long
a = Range("A1:b" & Range("a" & Rows.Count).End(xlUp).Row)
N = Application.Sum(Range("b1:b" & Range("b" & Rows.Count).End(xlUp).Row))


ReDim c(1 To N, 1 To 1)
For i = LBound(a, 1) To UBound(a, 1)
  If a(i, 2) <> "" Or a(i, 2) <> 0 Then
    For N = 1 To a(i, 2)
      ii = ii + 1
      c(ii, 1) = a(i, 1)
    Next N
  End If
Next i
Sheet40.Columns(131).ClearContents
Sheet40.Range("Ea1").Resize(UBound(c, 1), UBound(c, 2)) = c
Sheet40.Columns(131).AutoFit
End With
End Sub
Private Sub RepeatData2()


On Error Resume Next
With Worksheets("Calc2")
    .Activate
Dim a As Variant, c As Variant
Dim i As Long, ii As Long, N As Long
a = Range("c1:d" & Range("c" & Rows.Count).End(xlUp).Row)
N = Application.Sum(Range("d1:d" & Range("d" & Rows.Count).End(xlUp).Row))


ReDim c(1 To N, 1 To 1)
For i = LBound(a, 1) To UBound(a, 1)
  If a(i, 2) <> "" Or a(i, 2) <> 0 Then
    For N = 1 To a(i, 2)
      ii = ii + 1
      c(ii, 1) = a(i, 1)
    Next N
  End If
Next i
Sheet40.Columns(132).ClearContents
Sheet40.Range("EB1").Resize(UBound(c, 1), UBound(c, 2)) = c
Sheet40.Columns(132).AutoFit
End With
End Sub
Private Sub RepeatData3()


On Error Resume Next
With Worksheets("Calc2")
    .Activate
Dim a As Variant, c As Variant
Dim i As Long, ii As Long, N As Long
a = Range("e1:f" & Range("e" & Rows.Count).End(xlUp).Row)
N = Application.Sum(Range("f1:f" & Range("f" & Rows.Count).End(xlUp).Row))


ReDim c(1 To N, 1 To 1)
For i = LBound(a, 1) To UBound(a, 1)
  If a(i, 2) <> "" Or a(i, 2) <> 0 Then
    For N = 1 To a(i, 2)
      ii = ii + 1
      c(ii, 1) = a(i, 1)
    Next N
  End If
Next i
Sheet40.Columns(133).ClearContents
Sheet40.Range("EC1").Resize(UBound(c, 1), UBound(c, 2)) = c
Sheet40.Columns(133).AutoFit
End With
End Sub
Private Sub RepeatData4()


On Error Resume Next
With Worksheets("Calc2")
    .Activate
Dim a As Variant, c As Variant
Dim i As Long, ii As Long, N As Long
a = Range("G1:H" & Range("G" & Rows.Count).End(xlUp).Row)
N = Application.Sum(Range("H1:H" & Range("H" & Rows.Count).End(xlUp).Row))


ReDim c(1 To N, 1 To 1)
For i = LBound(a, 1) To UBound(a, 1)
  If a(i, 2) <> "" Or a(i, 2) <> 0 Then
    For N = 1 To a(i, 2)
      ii = ii + 1
      c(ii, 1) = a(i, 1)
    Next N
  End If
Next i
Sheet40.Columns(134).ClearContents
Sheet40.Range("ED1").Resize(UBound(c, 1), UBound(c, 2)) = c
Sheet40.Columns(134).AutoFit
End With
End Sub
Private Sub RepeatData5()


On Error Resume Next
With Worksheets("Calc2")
    .Activate
Dim a As Variant, c As Variant
Dim i As Long, ii As Long, N As Long
a = Range("I1:J" & Range("I" & Rows.Count).End(xlUp).Row)
N = Application.Sum(Range("J1:J" & Range("J" & Rows.Count).End(xlUp).Row))


ReDim c(1 To N, 1 To 1)
For i = LBound(a, 1) To UBound(a, 1)
  If a(i, 2) <> "" Or a(i, 2) <> 0 Then
    For N = 1 To a(i, 2)
      ii = ii + 1
      c(ii, 1) = a(i, 1)
    Next N
  End If
Next i
Sheet40.Columns(135).ClearContents
Sheet40.Range("EE1").Resize(UBound(c, 1), UBound(c, 2)) = c
Sheet40.Columns(135).AutoFit
End With
End Sub
Private Sub RepeatData6()


On Error Resume Next
With Worksheets("Calc2")
    .Activate
Dim a As Variant, c As Variant
Dim i As Long, ii As Long, N As Long
a = Range("K1:L" & Range("K" & Rows.Count).End(xlUp).Row)
N = Application.Sum(Range("L1:L" & Range("L" & Rows.Count).End(xlUp).Row))


ReDim c(1 To N, 1 To 1)
For i = LBound(a, 1) To UBound(a, 1)
  If a(i, 2) <> "" Or a(i, 2) <> 0 Then
    For N = 1 To a(i, 2)
      ii = ii + 1
      c(ii, 1) = a(i, 1)
    Next N
  End If
Next i
Sheet40.Columns(136).ClearContents
Sheet40.Range("EF1").Resize(UBound(c, 1), UBound(c, 2)) = c
Sheet40.Columns(136).AutoFit
End With
End Sub
Private Sub RepeatData7()


On Error Resume Next
With Worksheets("Calc2")
    .Activate
Dim a As Variant, c As Variant
Dim i As Long, ii As Long, N As Long
a = Range("M1:N" & Range("M" & Rows.Count).End(xlUp).Row)
N = Application.Sum(Range("N1:N" & Range("N" & Rows.Count).End(xlUp).Row))


ReDim c(1 To N, 1 To 1)
For i = LBound(a, 1) To UBound(a, 1)
  If a(i, 2) <> "" Or a(i, 2) <> 0 Then
    For N = 1 To a(i, 2)
      ii = ii + 1
      c(ii, 1) = a(i, 1)
    Next N
  End If
Next i
Sheet40.Columns(137).ClearContents
Sheet40.Range("EG1").Resize(UBound(c, 1), UBound(c, 2)) = c
Sheet40.Columns(137).AutoFit
End With
End Sub
Private Sub RepeatData8()


On Error Resume Next
With Worksheets("Calc2")
    .Activate
Dim a As Variant, c As Variant
Dim i As Long, ii As Long, N As Long
a = Range("O1:P" & Range("O" & Rows.Count).End(xlUp).Row)
N = Application.Sum(Range("P1:P" & Range("P" & Rows.Count).End(xlUp).Row))


ReDim c(1 To N, 1 To 1)
For i = LBound(a, 1) To UBound(a, 1)
  If a(i, 2) <> "" Or a(i, 2) <> 0 Then
    For N = 1 To a(i, 2)
      ii = ii + 1
      c(ii, 1) = a(i, 1)
    Next N
  End If
Next i
Sheet40.Columns(138).ClearContents
Sheet40.Range("EH1").Resize(UBound(c, 1), UBound(c, 2)) = c
Sheet40.Columns(138).AutoFit
End With
End Sub
Private Sub RepeatData9()


On Error Resume Next
With Worksheets("Calc2")
    .Activate
Dim a As Variant, c As Variant
Dim i As Long, ii As Long, N As Long
a = Range("Q1:R" & Range("Q" & Rows.Count).End(xlUp).Row)
N = Application.Sum(Range("R1:R" & Range("R" & Rows.Count).End(xlUp).Row))


ReDim c(1 To N, 1 To 1)
For i = LBound(a, 1) To UBound(a, 1)
  If a(i, 2) <> "" Or a(i, 2) <> 0 Then
    For N = 1 To a(i, 2)
      ii = ii + 1
      c(ii, 1) = a(i, 1)
    Next N
  End If
Next i
Sheet40.Columns(139).ClearContents
Sheet40.Range("EI1").Resize(UBound(c, 1), UBound(c, 2)) = c
Sheet40.Columns(139).AutoFit
End With
End Sub