时间戳

首页 > 解决方案 > Excel VBA - 在一张纸上找到并粘贴到另一个向下移动的目标单元格上的例程

excel - Excel VBA - 在一张纸上找到并粘贴到另一个向下移动的目标单元格上的例程

问题描述

非常感谢您对此的任何帮助！

我在 11 个 Excel 表上有 3 列，需要复制到唯一的目标表。

十一张表指的是月份，我需要在新工作簿上找到指该月份的一行，以便粘贴，向下移动单元格，然后搜索下个月并执行相同操作，直到复制所有 11 个月。

是）我有的：

子 PopulateFileTOupload()

'变量

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

' ================ 来源================

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

结束子

标签： excelvba

解决方案

您需要布局有关您的目标书的更多信息，以便指出您可以使用什么来标识要将数据复制到的行，但是...

假设您的目标工作簿中的数据格式如下，如果我对您的问题的理解是正确的，所有这些都在一张纸上：

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

基本步骤是：

确定要添加数据的行号

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

检查原始数据中的行数

Dim janRows As Long
janRows = rngToCopy1.rows.count

在您的目标书中插入那么多的空闲行

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

跨平台传输数据

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

有多种方法可以做到这一点（不止一种给猫剥皮的方法），但我认为这是最简单的。

我希望这会有所帮助，如果没有，我会很乐意提供进一步的帮助。

推荐阅读