Excel VBA从workbook1剪切行并将其粘贴到workbook2

问题描述

我遇到了一个问题，我无法在循环中找出问题，以便将其分解为这些期望的结果.我不太擅长循环部分，但我几乎理解了这一点，我只需要有人对此部分进行启发即可.

I've encountered a problems where i can't figure out the problem in the loop in order to cut it into these desires outcome. i am not good at the looping part but i almost got it, i just need someone to enlighten me with this part.

样本数据:
工作簿1
A B C D E<--(header) 1 2 3 4 5 1.1 2.1 3.1 4.1 5.1 1.2 2.2 3.2 4.2 5.2 1.3 2.3 3.3 4.3 5.3

Sample Data:
Workbook 1
A B C D E<--(header) 1 2 3 4 5 1.1 2.1 3.1 4.1 5.1 1.2 2.2 3.2 4.2 5.2 1.3 2.3 3.3 4.3 5.3

工作簿2
A B C D E<--(header)Apple Boy Cat Dog EleApple1 Boy1 Cat1 Dog1 Ele1Apple2 Boy2 Cat2 Dog2 Ele2Apple3 Boy3 Cat3 Dog3 Ele3

Workbook 2
A B C D E<--(header)Apple Boy Cat Dog EleApple1 Boy1 Cat1 Dog1 Ele1Apple2 Boy2 Cat2 Dog2 Ele2Apple3 Boy3 Cat3 Dog3 Ele3

工作簿2中的需求输出:
A B C D E<--(header)Apple Boy Cat Dog Ele1 2 3 4 5Apple1 Boy1 Cat1 Dog1 Ele11.1 2.1 3.1 4.1 5.1Apple2 Boy2 Cat2 Dog2 Ele21.2 2.2 3.2 4.2 5.2Apple3 Boy3 Cat3 Dog3 Ele31.3 2.3 3.3 4.3 5.3

Desire Output in Workbook2:
A B C D E<--(header)Apple Boy Cat Dog Ele1 2 3 4 5Apple1 Boy1 Cat1 Dog1 Ele11.1 2.1 3.1 4.1 5.1Apple2 Boy2 Cat2 Dog2 Ele21.2 2.2 3.2 4.2 5.2Apple3 Boy3 Cat3 Dog3 Ele31.3 2.3 3.3 4.3 5.3

这是我的代码.

 Sub foo()
 Dim x As Workbook
 Dim y As Workbook
 Dim X1 As Worksheet

 Set x = Workbooks.Open("C:\Documents and Settings\DON\My     Documents\testingmacro2.xlsx")   <----Workbook 1

 Set y = Workbooks.Open("C:\Documents and Settings\DON\My Documents\testingmacro3.xlsx")   <----Workbook 2

Set X1 = x.Sheets(2)       <----Workbook 1
Set Y1 = y.Sheets(1)       <----Workbook 2

For i = 2 To 1000

If X1.Cells(i, 2) = "" Then
   Exit For
   End If

    For j = 1 To 1000 Step 5   (this is the part where i am having problems to get the desires outcome)


        If Y1.Cells(i, j).Value = "" Then
            Exit For
            Else

            X1.Cells(i, j).Resize(, 5).Cut
            i = i + 1
            Y1.Range("A" & i).Insert xlShiftDown
            End If

            Next

       Next

x.Close
y.Close True

End Sub

推荐答案

感谢@RawrPlus提供的解决方案，我确实修改了一些部分，以使其完全符合我的要求.这是我的答案.

Thanks to @RawrPlus for the solutions, i did amend some of the parts in order to make it exactly what i want. Here are my answers.

Option Explicit
Private Sub table_to_table()
'Declaration
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set wb1 = Workbooks.Open("C:\Documents and Settings\lye.yan.nian\My Documents\testingmacro2.xlsx")
Set wb2 = Workbooks.Open("C:\Documents and Settings\lye.yan.nian\My Documents\testingmacro3.xlsx")
Set ws1 = wb1.Sheets("Test2")
Set ws2 = wb2.Sheets("Test1")

Dim res_lr As Long
Dim lr2 As Long
lr2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row

Dim copyrange As Range
Dim i As Long
For i = 2 To lr2


'Set copyrange = ws2.Range(Cells(i, 2), Cells(i, 6))
Set copyrange = ws2.Range(ws2.Cells(i, 1), ws2.Cells(i, 5))
copyrange.Copy

res_lr = ws2.Cells(Rows.Count, 8).End(xlUp).Row
MsgBox res_lr
ws2.Range(Cells(res_lr + 1, 8), Cells(res_lr + 1, 12)).PasteSpecial xlPasteValues /* This is the part where i make changes */

'Set copyrange = ws1.Range(Cells(i, 2), Cells(i, 6))
Set copyrange = ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, 5))
copyrange.Copy

ws2.Range(Cells(res_lr + 2, 8), Cells(res_lr + 2, 12)).PasteSpecial xlPasteValues /* This is the part where i make changes */

Next i

wb1.Close

End Sub

这篇关于Excel VBA从workbook1剪切行并将其粘贴到workbook2的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！