Hi everyone! I am very new to VBA but I have been doing a lot of research online and have figure out how to make a macro that lets me transfer specific ranges from one workbook to a master workbook thats has a sheet for each month. The macro works well except for one issue I am encountering. The copied data is being pasted into the wrong sheet in the master workbook. One of the pieces of data I am transferring is the date. The master workbook is suppose to see the date and paste the data into the appropriate sheet. Unfortunately, that is not happening.
For example, if I set the date as November 12th and then activate the macro, the data gets pasted into the sheet for July. I will post my code below.
Any help would be greatly appreciated! Thanks in advance!
For example, if I set the date as November 12th and then activate the macro, the data gets pasted into the sheet for July. I will post my code below.
Any help would be greatly appreciated! Thanks in advance!
Code:
Public Sub transformData()
Dim i, nLastRowMe, nLastRowOut, nRecords As Long
Dim strSheet, str As String
Dim wbMe, wbOut As Workbook
'Application.ScreenUpdating = False
Set wbMe = ActiveWorkbook
i = 36
Do While (i > 16)
If Trim(Range("B" & i)) <> "" Then
nLastRowMe = i
i = 16
End If
i = i - 1
Loop
If nLastRowMe <= 16 Then
MsgBox "There are no records to be transfered!"
Exit Sub
End If
nRecords = nLastRowMe - 17
Set wbOut = Workbooks.Open(wbMe.Path & "/2018MonthlyA.xls")
strSheet = Month(wbMe.Sheets("Form").Range("P2"))
With wbOut.Sheets(strSheet)
.Activate
' nLastRowOut = .Range("A500").End(xlUp).Row + 1
i = 220
nLastRowOut = i
Do While (i > 41)
str = .Range("A" & i).Value & .Range("B" & i).Value & .Range("C" & i).Value & .Range("D" & i).Value & .Range("E" & i).Value & .Range("F" & i).Value & .Range("G" & i).Value & .Range("H" & i).Value & .Range("I" & i).Value & .Range("J" & i).Value & .Range("K" & i).Value & .Range("L" & i).Value & .Range("M" & i).Value
If Replace(str, 0, "") <> "" Then
nLastRowOut = i + 1
GoTo copySections
End If
i = i - 1
Loop
copySections:
wbMe.Sheets("Form").Range("K17:K36" & nLastRowMe).Copy
.Range("F" & nLastRowOut).PasteSpecial xlPasteValues
wbMe.Sheets("Form").Range("K17:K36" & nLastRowMe).Copy
.Range("J" & nLastRowOut).PasteSpecial xlPasteValues
wbMe.Sheets("Form").Range("Q17:Q36" & nLastRowMe).Copy
.Range("M" & nLastRowOut).PasteSpecial xlPasteValues
nRecords = nRecords + nLastRowOut
wbMe.Sheets("Form").Range("A4").Copy
.Range("A" & nLastRowOut & ":A" & nRecords).PasteSpecial xlPasteValues
.Range("A" & nLastRowOut & ":A" & nRecords).Font.Size = 8
wbMe.Sheets("Form").Range("C9").Copy
.Range("B" & nLastRowOut & ":B" & nRecords).PasteSpecial xlPasteValues
wbMe.Sheets("Form").Range("C11").Copy
.Range("C" & nLastRowOut & ":C" & nRecords).PasteSpecial xlPasteValues
wbMe.Sheets("Form").Range("B17").Copy
.Range("D" & nLastRowOut & ":D" & nRecords).PasteSpecial xlPasteValues
wbMe.Sheets("Form").Range("P3").Copy
.Range("E" & nLastRowOut & ":E" & nRecords).PasteSpecial xlPasteValues
End With
exitHere:
With wbOut
'.Save
'.Close
End With
MsgBox "Data has been transfered."
Application.CutCopyMode = False
'Application.ScreenUpdating = True
End Sub