VBA change Paste range on full month

[MarkCBB]

HI there,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o> </o>
I need to be able to offset the pasting of a database to the right of the same database once the month has been completed (i.e. all dates in the Month). In order to do this, I have built an import Worksheet that currently appends the day’s data to dump to the master database. <o></o>
<o> </o>
I am looking for some clever VBA code to work out if Column C has all the days/Dates of a month (i.e.January), it then needs to change the range to allow the next day’s/Months data to be pasted (1<SUP>st</SUP> Feb). Once all the days in February have been appended to the February range, the new pasting range is offset and then the data for March starts building. <o></o>
<o> </o>
The range of the data is A:J, the Next range needs to be K:T and so forth. The name of the worksheet that the data is being pasted is “M_DB”<o></o>
<o> </o>
I use Xl2010 when creating these tools but please also find below the code that I use to append from the input worksheet to the M_DB worksheet<o></o>
<o> </o>
<o>Maybe the trigger to Offset the range can be the Month itself so incase 1 date/day is missed the date is still by month. If it makes things easier I can build a table with the name/Number of the Month to a range i.e. 1 (For January) and the range would be A:J. </o>
<o> </o>

[SIZE=3][FONT=Calibri]Sub ImportData()<o:p></o:p>[/FONT][/SIZE]
<o:p>[FONT=Calibri][SIZE=3] [/SIZE][/FONT]</o:p>
[SIZE=3][FONT=Calibri]Dim IRng As Range<o:p></o:p>[/FONT][/SIZE]
<o:p>[FONT=Calibri][SIZE=3] [/SIZE][/FONT]</o:p>
[SIZE=3][FONT=Calibri]Sheets("INPUT").Select<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Range("A2:J2").Select<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Range(Selection, Selection.End(xlDown)).Select<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Set IRng = Selection<o:p></o:p>[/FONT][/SIZE]
<o:p>[FONT=Calibri][SIZE=3] [/SIZE][/FONT]</o:p>
[SIZE=3][FONT=Calibri]Sheets("Master_DB").Visible = True<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Sheets("Master_DB").Select<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Range("A1048576").Select<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Selection.End(xlUp).Select<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]ActiveCell.Offset(1, 0).Select<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]IRng.Copy<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]ActiveSheet.Paste<o:p></o:p>[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]End<o:p></o:p>[/FONT][/SIZE]

 

[MarkCBB]

I got it!

Probably a much better way to do this, but this is how I solved it. Just an FYI.

Sub LoadTRANSDB()
Dim MValue As Range
Dim TRANSDB As Range
Dim JanR As Range
Dim FebR As Range
Dim MarR As Range
Dim AprR As Range
Dim MayR As Range
Dim JunR As Range
Dim JulR As Range
Dim AugR As Range
Dim SepR As Range
Dim OctR As Range
Dim NovR As Range
Dim DecR As Range

'The range below "C1" contains the the following formula =Month(K3) K3 is the date column
Range("C1").Select
Set MValue = Selection

'This is the Database range on the Input Worksheet
Range("A3:R100000").Select
Range(Selection, Selection.End(xlDown)).Select
Set TRANSDB = Selection

'This is the worksheet where all the databases will be placed, according to Month
Sheets("TRANS_DB").Visible = True
Sheets("TRANS_DB").Select
'>>>>>>>>>>>>>>>>>>The following code defines the different Month ranges that are going to be linked to the Look up range in range A:T

'This is the range where the data for Jan will be placed -1
Range("U1048576").Select
Set JanR = Selection

'This is the range where the data for Feb will be placed -2
Range("AO1048576").Select
Set FebR = Selection

'This is the range where the data for Mar will be placed -3
Range("BI1048576").Select
Set MarR = Selection

'This is the range where the data for Apr will be placed -4
Range("CB1048576").Select
Set AprR = Selection

'This is the range where the data for May will be placed -5
Range("CV1048576").Select
Set MayR = Selection

'This is the range where the data for Jun will be placed -6
Range("DP1048576").Select
Set JunR = Selection

'This is the range where the data for July will be placed -7
Range("EJ1048576").Select
Set JulR = Selection

'This is the range where the data for August will be placed -8
Range("FD1048576").Select
Set AugR = Selection

'This is the range where the data for September will be placed -9
Range("FX1048576").Select
Set SepR = Selection

'This is the range where the data for October will be placed-10
Range("GR1048576").Select
Set OctR = Selection

'This is the range where the data for November will be placed -11
Range("HL1048576").Select
Set NovR = Selection

'This is the range where the data for December will be placed-12
Range("IF1048576").Select
Set DecR = Selection
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
If MValue.Value = 1 Then
TRANSDB.Copy
JanR.Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
TRANSDB.ClearContents
Call GoBack
Else

If MValue.Value = 2 Then
TRANSDB.Copy
FebR.Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
TRANSDB.ClearContents
Call GoBack
Else

If MValue.Value = 3 Then
TRANSDB.Copy
MarR.Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
TRANSDB.ClearContents
Call GoBack
Else

If MValue("C2").Value = 4 Then
TRANSDB.Copy
AprR.Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
TRANSDB.ClearContents
Call GoBack
Else

If MValue.Value = 5 Then
TRANSDB.Copy
MayR.Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
TRANSDB.ClearContents
Call GoBack
Else

If MValue.Value = 6 Then
TRANSDB.Copy
JunR.Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
TRANSDB.ClearContents
Call GoBack
Else

If MValue.Value = 7 Then
TRANSDB.Copy
JulR.Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
TRANSDB.ClearContents
Call GoBack
Else

If MValue.Value = 8 Then
TRANSDB.Copy
AugR.Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
TRANSDB.ClearContents
Call GoBack
Else

If MValue.Value = 9 Then
TRANSDB.Copy
SepR.Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
TRANSDB.ClearContents
Call GoBack
Else

If MValue.Value = 10 Then
TRANSDB.Copy
OctR.Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
TRANSDB.ClearContents
Call GoBack
Else

If MValue.Value = 11 Then
TRANSDB.Copy
NovR.Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
TRANSDB.ClearContents
Call GoBack
Else

If MValue.Value = 12 Then
TRANSDB.Copy
DecR.Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
TRANSDB.ClearContents
Call GoBack

Else
MsgBox ("The date range is not in the correct column")


End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If

End Sub

Sub GoBack()
Sheets("TRANS_DB").Visible = False
Sheets("Input").Select
MsgBox ("Still need to make the message!!!!")
End Sub