Excel VBA - Routine that finds on one sheet and paste on another moving destination cells down

Question

Really appreciated any help on this!

I have 3 columns on 11 excel sheets that need to be copied to a unique destination sheet.

The eleven sheets refer to months, and I need to find a row referring to that month on the new worbook in order to paste, moving cells down, and then search for the next month and do the same, until all 11 months are copied.

What I have:

Sub PopulateFileTOupload()

' variables

Dim strFileToSave As String

Dim wbSource As Workbook
Dim wsSource As Worksheet

Dim wbTarget As Workbook
Dim wsTarget As Worksheet

Dim rngToCopy1 As Range, rngToCopy2 As Range, rngToCopy3 As Range
Dim dt As String, wbNam As String, wbDir As String

Dim FoundCell As Range, FirstAddr As String, fnd As String, i As Long

' ================ SOURCE ================

Set wbSource = Workbooks.Open("C:\Users\MLOURENC\Documents\0041_PRORATA_ANNUAL_CONTRACTS_UPLOAD.xls")
Set wsSource = wbSource.Worksheets("Month1")

' ================ COPY & PASTE ================

' source range1

Set rngToCopy1 = wsSource.Range("E1", wsSource.Range("E1").End(xlDown))
Set rngToCopy2 = wsSource.Range("N1", wsSource.Range("N1").End(xlDown))
Set rngToCopy3 = wsSource.Range("P1", wsSource.Range("P1").End(xlDown))

Set wbTarget = Workbooks.Open("C:\Users\MLOURENC\Desktop\UP_FRONT S&D\0041_PT\2.Anual-Template\0041_PRORATA ANNUAL CONTRACTS_UPLOAD_TEMPLATE.xls")


' Paste range1


' DON 't know....



' ================ SAVE ================
wbNam = "0041_PRORATA_ANNUAL_CONTRACTS_UPLOAD_READY_"
dt = Format(CStr(Now), "dd_mm_yyyy_hh_mm")
wbTarget.SaveAs Filename:=wbNam & dt
' ================ CLOSE ================'
Application.DisplayAlerts = False
wbTarget.Close
Application.DisplayAlerts = True

End Sub

Answer 1

You need to layout a bit more information about your destination book, in order to point out what you can use to identify the row to copy your data to, however...

Lets say the data in your destination workbook is formatted something like this, all in one sheet if my understanding of your question is right:

January
    Data
    Data
    Data
    Data
February
    Data
    Data
    Data
    Data
ETC ETC
    Data
    Data
    Data
    Data

The basic steps would be:

Identify the row number where you want to add data

Dim monthRow As Long
monthRow = wbTarget.Sheets(1).Range("A:A").Find("January:", LookIn:=xlValues).Row

Check number of rows in your original data

Dim janRows As Long
janRows = rngToCopy1.rows.count

Insert that many free rows in your target book

wbTarget.Sheets(1).Rows(monthRow + 1 & ":" & monthRow + janRows).EntireRow.Insert

Transfer data across

wbTarget.Sheets(1).Range("B" & monthRow + 1 & ":B" & monthRow + janRows) = rngToCopy1

There are various ways to do this (more than one way to skin a cat), but this would be easiest i think.

I hope this helps, if not i`ll be happy to assist further.